(defun c:CgH() ;复制变特性--------------------------------------------
(setq s (ssget))
(SETQ CM (getstring "\nINPUT THE LAYER NAME:"))
(COMMAND "COPY" S "" "0,0" "0,0")
(COMMAND "CHANGE" S "" "P" "LA" CM "")
(restore_old_error) )
(DEFUN C:PP() ;连成多义线-----------------------------------------------
(SETQ SS(SSGET))
(IF (>(SSLENGTH SS) 1)
(COMMAND "PEDIT" SS "Y" "J" SS "" "") ) )
(defun c:FM() ;连续倒圆角-----------------------------------------------
(setq cmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq r (getreal "\n Enter fillet radius:"))
(prompt"\nselect first line:")
(setq p1 (cadr (entsel)))
(prompt"\nselect second line:")
(setq p2 (cadr (entsel)))
(command "fillet" "r" R "fillet" p1 p2)
(prompt"\nselect second line:")
(REPEAT 1000
(setq p1 (cadr (entsel)))
(command "fillet" "r" R "fillet" p1 p2)
(prompt"\nselect second line:")
(setq p2 (cadr (entsel)))
(command "fillet" "r" R "fillet" p1 p2)
(prompt"\nselect second line:")
(princ))
(setvar "cmdecho" cmd) )
(defun c:gk();变直径---------------------------------
(init_bonus_error
(list
(list "cmdecho" 0
"highlight" 1
)
T ;flag. True means use undo for error clean up.
);list
);init_bonus_error
(setq d (getreal "\nDiameter:"))
(setq s (ssget))
(while (/= s nil)
(setq n (sslength s))
(setq x 0)
(setq r (/ d 2))
(while (< x n)
(setq m (ssname s x))
(setq m1 (entget m))
(setq c (cdr (assoc 0 m1)))
(setq x (+ x 1))
(IF (= c "CIRCLE")
(progn
(setq lay (cdr (assoc 8 m1)))
(setq ts (tblsearch "layer" lay))
(setq nn (cdr (assoc 70 ts)))
(if (/= nn 4)
(progn
(setq la (cdr (assoc 40 m1)))
(setq px (cadr (assoc 10 m1)))
(setq py (caddr (assoc 10 m1)))
(setq p1 (list px py))
(SETQ p(TRANS p1 0 1))
(setq b (/ r la))
(command "_.scale" m "" "none" p b)
)) ))
(princ) )
(setq d (getreal "\nDiameter:"))
(setq s (ssget)) )
(restore_old_error) )