以前写过,希望对您有用
 - ;;;桩重画
- (DEFUN C:xcct (/ ss n en ent pt lst)
- (SETQ ss (SSGET '((0 . "arc,circle")(8 . "桩")))
- lst nil
- )
- (REPEAT (SETQ N (SSLENGTH SS))
- (SETQ EN (SSNAME SS (SETQ N (1- N))))
- (setq ent (entget en))
- (SETQ PT (CDR (ASSOC 10 ent)))
- (if (null (vl-remove-if-not '(lambda (x) (equal pt x 1e-6)) lst)
- )
- (progn (setq lst (cons pt lst))
- (entmake (list '(0 . "circle")
- (cons 10 pt)
- (assoc 8 ent)
- (assoc 6 ent)
- (assoc 40 ent)
- )
- )
- )
- )
- (entdel en)
- )
- (princ)
- )
|