[求助]求高人帮忙编写一画岩棉 的lisp程序

vken7az2p

(DEFUN C:TS
(/ ANG C:N DST DST_2 E:EN:D E:EN:T E:PT1 E:PT2 EN ET I L:EN L:EN:R PT:D0 PT:D1 PT:D2 PT:D2:D PT:D3 PT:T0 PT:T1 PT:T2 PT:T3 RR WW)
(SETQ EN (CAR(ENTSEL"\n选取LINE:")))
(SETQ WW (GETREAL "\n设定宽度<50>"))
(IF (NULL WW) (SETQ WW 50.0))
(SETQ RR (GETREAL "\n设定半径<5>"))
(IF (NULL RR) (SETQ RR 5.0))
(SETQ ET (ENTGET EN))
(SETQ E:PT1 (CDR(ASSOC 10 ET)))
(SETQ E:PT2 (CDR(ASSOC 11 ET)))
(SETQ ANG (ANGLE E:PT1 E:PT2))
(SETQ DST (DISTANCE E:PT1 E:PT2))
(SETQ C:N (FIX (/ DST (* RR 2.0))))
(SETQ DST_2 (* C:N (* RR 2.0)))
(SETQ E:PT2 (POLAR E:PT1 ANG DST_2))
(SETQ PT:T0 (POLAR E:PT1 (+ ANG (/ PI 2.0)) (/ WW 2.0)))
(SETQ PT:D0 (POLAR E:PT2 (- ANG (/ PI 2.0)) (/ WW 2.0)))
(SETQ PT:T1 (POLAR E:PT1 (+ ANG (/ PI 2.0)) (- (/ WW 2.0) RR)))
(SETQ PT:D1 (POLAR E:PT2 (- ANG (/ PI 2.0)) (- (/ WW 2.0) RR)))
(SETQ PT:T2 (POLAR PT:T1 ANG RR))
(SETQ PT:D2 (POLAR PT:D0 ANG RR))
(VL-CMDF "_.ARC" "NON" PT:T2 "E" "NON" PT:T0 "R" RR)
(VL-CMDF "_.ARC" "NON" PT:D1 "E" "NON" PT:D2 "R" RR)
(SETQ PT:T3 (POLAR PT:T2 ANG (* 2.0 RR)))
(SETQ PT:D2:D (POLAR PT:T1 (- ANG (/ PI 2.0)) (- WW (* 2.0 RR))))
(SETQ PT:D3 (POLAR PT:D2:D ANG (* 2.0 RR)))
(VL-CMDF "_.LINE" "NON" PT:T2 "NON" PT:D2:D "")
(SETQ L:EN (ENTLAST))
(VL-CMDF "_.LINE" "NON" PT:T2 "NON" PT:D3 "")
(SETQ L:EN:R (ENTLAST))
(VL-CMDF "_.ARC" "NON" PT:T3 "E" "NON" PT:T2 "R" RR)
(SETQ E:EN:T (ENTLAST))
(VL-CMDF "_.ARC" "NON" PT:D2:D "E" "NON" PT:D3  "R" RR)
(SETQ E:EN:D (ENTLAST))
(SETQ I 0)
(REPEAT (- C:N 1)
(SETQ I (1+ I))

(VL-CMDF "_.COPY" E:EN:T ""
  "NON" PT:T3
  "NON" (POLAR PT:T3 ANG (* I (* 2.0 RR)))
  )
(VL-CMDF "_.COPY" E:EN:D ""
  "NON" PT:D3
  "NON" (POLAR PT:D3 ANG (* I (* 2.0 RR)))
  )
(VL-CMDF "_.COPY" L:EN ""
  "NON" PT:D2:D
  "NON" (POLAR PT:D2:D ANG (* I (* 2.0 RR)))
  )
(VL-CMDF "_.COPY" L:EN:R ""
  "NON" PT:D3
  "NON" (POLAR PT:D3 ANG (* I (* 2.0 RR)))
  )
)
(VL-CMDF "_.COPY" L:EN ""
  "NON" PT:D2:D
  "NON" (POLAR PT:D2:D ANG (* (1+ I) (* 2.0 RR)))
  )
)

试试看吧

最后没有成为聚合线而已

samshs

如果圆弧及多段线也能用上就最完美啦！