本帖最后由 ZZXXQQ 于 2016-10-7 07:04 编辑
 - (defun c:dkK (/ esel ename entna s st1 st2 ed1 ed2)
- (defun dxf (code elst) (cdr(assoc code elst)))
- ; (setq temperr *error*)
- ; (setq *error* trap8)
- (mapcar 'set '(old1 old cmd os)
- (mapcar 'getvar '("blipmode" "pickfirst" "cmdecho" "osmode"))
- )
- (command "undo" "m")
- (mapcar 'setvar '("cmdecho" "bilipmode" "pickfirst" "osmode") '(0 0 0 0))
- (prompt "\n选择线变成双线:")
- (if (setq ss (ssget '((0 . "ARC,CIRCLE,LINE")))) (progn
- (if (= dlw nil) (setq dlw 0.3))
- (setq s (getstring (strcat "\n当前双线宽度:<" (rtos dlw 2) "> ")))
- (if (/= s "") (setq dlw (atof s)))
- (repeat (setq i (sslength ss))
- (setq en (ssname ss (setq i (1- i))))
- (setq elist (entget en))
- (redraw en 3)
- (setq enname (dxf 0 elist))
- (cond
- ((= enname "LINE")
- (setq st (dxf 10 elist))
- (setq ed (dxf 11 elist))
- (setq st1 (polar st (+ (angle st ed) (/ pi 2)) (/ dlw 2)))
- (setq ed1 (polar ed (+ (angle st ed) (/ pi 2)) (/ dlw 2)))
- (setq st2 (polar st (+ (angle st ed) (* pi 1.5)) (/ dlw 2)))
- (setq ed2 (polar ed (+ (angle st ed) (* pi 1.5)) (/ dlw 2)))
- (entmake (list (cons 0 "LINE") (cons 10 st1) (cons 11 ed1)))
- (entmake (list (cons 0 "LINE") (cons 10 st2) (cons 11 ed2)))
- (if (> dlw 0.7) (progn
- (entmake (list (cons 0 "LINE") (cons 10 st1) (cons 11 st2)))
- (entmake (list (cons 0 "LINE") (cons 10 ed1) (cons 11 ed2)))
- ))
- )
- ((= enname "CIRCLE")
- (setq pc (dxf 10 elist) r (dxf 40 elist))
- (entmake(list'(0 . "CIRCLE")(cons 10 pc)(cons 40 (+ r (/ dlw 2)))))
- (entmake(list'(0 . "CIRCLE")(cons 10 pc)(cons 40 (- r (/ dlw 2)))))
- )
- ((= enname "ARC")
- (setq pc (dxf 10 elist) r (dxf 40 elist))
- (setq st (polar pc (dxf 50 elist) r))
- (setq ed (polar pc (dxf 51 elist) r))
- (entmake(list'(0 . "ARC")(cons 10 pc)(cons 40 (+ r (/ dlw 2)))(assoc 50 elist)(assoc 51 elist)))
- (entmake(list'(0 . "ARC")(cons 10 pc)(cons 40 (- r (/ dlw 2)))(assoc 50 elist)(assoc 51 elist)))
- (if (> dlw 0.7) (progn
- (setq st1 (polar pc (dxf 50 elist) (+ r (/ dlw 2))))
- (setq st2 (polar pc (dxf 50 elist) (- r (/ dlw 2))))
- (setq ed1 (polar pc (dxf 51 elist) (+ r (/ dlw 2))))
- (setq ed2 (polar pc (dxf 51 elist) (- r (/ dlw 2))))
- (entmake (list (cons 0 "LINE") (cons 10 st1) (cons 11 st2)))
- (entmake (list (cons 0 "LINE") (cons 10 ed1) (cons 11 ed2)))
- ))
- )
- )
- (entdel ename)
- )
- ))
- (mapcar 'setvar '("cmdecho" "blipmode" "pickfirst" "osmode") '(cmd old1 old os))
- ; (setq *error* temperr)
- (princ)
- )
程序改了,再试一下。 |