치수의 숫자값을 강제입력으로 변경해주는 lisp

인터넷에서 받은 자료인데 출처를 알 수가 없어요.

 

치수의 숫자값을 강제입력으로 변경해주는 lisp입니다.

 

 

 

(defun c:dg( / ss ddc ent change n cm fr bk ddd val dac)
(defun rtd (a)(/ (* a 180.0) pi))
    (setq cm (getvar "cmdecho"))
    (setvar "cmdecho" 0)
(prompt "\n 고정시킬 치수를 선택하세요. <엔터(도면전체)> : ")
(if (= (setq ss (ssget)) nil)
(setq ss (ssget "x" '((0 . "DIMENSION"))))
)
(if ss
(progn
(command "undo" "be")
(setq ddc (getvar "DIMDEC") dac (getvar "DIMADEC") n 0)
(repeat (sslength ss)
(setq ent (entget (ssname ss n)))
(setq fr "" bk "" ddd ddc)
(setq dnum (cdr (assoc 70 ent)))
(setq val (cdr (assoc 42 ent)))
(cond  ((or (= dnum 163) (= dnum 35)) (setq fr "%%c"))
((or (= dnum 36) (= dnum 41) (= dnum 164) (= dnum 169)) (setq fr "R"))
((= dnum 34) (setq bk "%%d" val (rtd val) ddd dac))
)
(setq change (subst (cons 1 (strcat fr (Cmo_Text (rtos val 2 ddd)) bk)) (assoc 1 ent) ent))
(entmod change)
(setq n (1+ n))
)
(command "undo" "e")
)
)
    (setvar "cmdecho" cm)
    (princ)
)

;주말농부님의 콤마리습을 루틴으로 개조 ^^;;
(defun Cmo_Text(String / txlen n tem ntx a1)
    (setq txlen (strlen String))
    (setq n txlen tem 0 ntx "")
    (repeat txlen
(setq a1 (substr String n 1))
(if (and (>= (ascii a1) 48) (<= (ascii a1) 57))
(setq tem (+ tem 1))
(setq tem 0)
)
(if (= tem 4) (setq ntx (strcat "," ntx) tem 1) )
(setq ntx (strcat a1 ntx))
(setq n (- n 1))
     )
    ntx
)

 

 

(스케일치수값고정)dg.lsp

0.00MB