公布楼主的代码:
;替换炸开的箭头 ZZXXQQ 2006.8.16
(DEFUN C:CHARROW ()
(SETVAR "CMDECHO" 0)
(COMMAND ".UNDO" "BE")
(SETQ OLDOS (GETVAR "OSMODE"))
(SETVAR "OSMODE" 0)
(IF (SETQ SS (SSGET "X" '((0 . "SOLID")))) (PROGN
(SETQ I -1)
(REPEAT (SSLENGTH SS)
(SETQ EN (SSNAME SS (SETQ I (1+ I)))
ENT (ENTGET EN)
P1 (CDR (ASSOC 10 ENT))
P2 (CDR (ASSOC 11 ENT))
P3 (CDR (ASSOC 12 ENT))
P4 (CDR (ASSOC 13 ENT)))
(IF (EQUAL (DISTANCE P3 P4) 0 1E-6) (PROGN
(SETQ P5 (POLAR P2 (ANGLE P2 P1) (* (DISTANCE P2 P1) 0.5))
SCA (/ (DISTANCE P3 P5) 2)
ANG (/ (* (ANGLE P5 P3) 180) PI))
(COMMAND "ERASE" EN "" "-INSERT" "DIMARROW" P3 SCA "" ANG)
))
)
))
(COMMAND ".UNDO" "E")
(SETVAR "OSMODE" OLDOS)
(SETVAR "CMDECHO" 1)
(PRINC)
)
;替换子形箭头 ZZXXQQ 2006.8.17
(DEFUN C:CHARROW2 ()
(SETVAR "CMDECHO" 0)
(COMMAND ".UNDO" "BE")
(SETQ OLDOS (GETVAR "OSMODE"))
(SETVAR "OSMODE" 0)
(IF (SETQ SS (SSGET "X" '((0 . "SHAPE")))) (PROGN
(SETQ I -1)
(REPEAT (SSLENGTH SS)
(SETQ EN (SSNAME SS (SETQ I (1+ I)))
ENT (ENTGET EN)
P1 (CDR (ASSOC 10 ENT))
NM (CDR (ASSOC 2 ENT))
ANG (+ (/ (* (CDR (ASSOC 50 ENT)) 180) PI) 180)
SCA (* (CDR (ASSOC 40 ENT)) 10))
(IF (= NM "ARROW0")
(COMMAND "ERASE" EN "" "-INSERT" "DIMARROW" P1 SCA "" ANG)
)
)
))
(COMMAND ".UNDO" "E")
(SETVAR "OSMODE" OLDOS)
(SETVAR "CMDECHO" 1)
(PRINC)
)
;替换炸开的箭头和子形箭头 ZZXXQQ 2006.8.17
(DEFUN C:CHARROW3 ()
(SETVAR "CMDECHO" 0)
(COMMAND ".UNDO" "BE")
(SETQ OLDOS (GETVAR "OSMODE"))
(SETVAR "OSMODE" 0)
(IF (SETQ SS (SSGET "X" '((0 . "SOLID")))) (PROGN
(SETQ I -1)
(REPEAT (SSLENGTH SS)
(SETQ EN (SSNAME SS (SETQ I (1+ I)))
ENT (ENTGET EN)
P1 (CDR (ASSOC 10 ENT))
P2 (CDR (ASSOC 11 ENT))
P3 (CDR (ASSOC 12 ENT))
P4 (CDR (ASSOC 13 ENT)))
(IF (EQUAL (DISTANCE P3 P4) 0 1E-6) (PROGN
(SETQ P5 (POLAR P2 (ANGLE P2 P1) (* (DISTANCE P2 P1) 0.5))
SCA (/ (DISTANCE P3 P5) 2)
ANG (/ (* (ANGLE P5 P3) 180) PI))
(COMMAND "ERASE" EN "" "-INSERT" "DIMARROW" P3 SCA "" ANG)
))
)
))
(IF (SETQ SS (SSGET "X" '((0 . "SHAPE")))) (PROGN
(SETQ I -1)
(REPEAT (SSLENGTH SS)
(SETQ EN (SSNAME SS (SETQ I (1+ I)))
ENT (ENTGET EN)
P1 (CDR (ASSOC 10 ENT))
NM (CDR (ASSOC 2 ENT))
ANG (+ (/ (* (CDR (ASSOC 50 ENT)) 180) PI) 180)
SCA (* (CDR (ASSOC 40 ENT)) 10))
(IF (= NM "ARROW0")
(COMMAND "ERASE" EN "" "-INSERT" "DIMARROW" P1 SCA "" ANG)
)
)
))
(COMMAND ".UNDO" "E")
(SETVAR "OSMODE" OLDOS)
(SETVAR "CMDECHO" 1)
(PRINC)
) |