排水管线
如何修改下列的代碼? 可以做到將互垂或是相交的管線變成如下圖的排水管線，最重要的是要能指定排水方向。
(defun c:arcit ( / *error* _inters arc objs pts rad dir ang)
(vl-load-com)
(defun *error* (msg)
(command "._undo" "_end")
(setvar 'osmode old_os) (setvar 'cmdecho cmd1)
)
(defun _Inters (ss / en pts ss en pts)
(repeat (sslength ss)
(setq en (cons (vlax-ename->vla-object (ssname ss 0)) en))
(ssdel (ssname ss 0) ss)
)
(while en
(setq pt (car en))
(mapcar '(lambda (p l / l pt_)
(while l (if (setq v (vlax-invoke p
'IntersectWith (car l)
acExtendNone ))
(repeat (/ (length v) 3)
(setq pt_ (list (car v) (cadr v) (caddr v))
v (member (nth 3 v) v)
)
(if (and pt_ (not (vl-position pt_ pts)))
(setq pts (cons pt_ pts)))))
(setq l (cdr l))))
(list pT)
(list (setq en (vl-remove pt en)))
)
) pts
)
(defun Arc (cen rad sAng eAng)
(entmakex (list (cons 0 "ARC") (cons 10 cen)
(cons 40 rad) (cons 50 sAng)
(cons 51 eAng))))
(setq old_os (getvar 'osmode)
plw (getvar 'plinewid)
cmd1 (getvar 'cmdecho)
clyer (getvar 'clayer))
(setvar 'osmode 0)
(setvar 'cmdecho 0)
(command "._undo" "_begin")
(setq objs (ssget ":L" '((0 . "*LINE"))))
(setq pts (_inters objs))
(setq rad (if (not rad) 1.0 rad))
(setq rad (cond
((getdist (strcat "\nEnter distance"
(if rad (strcat " <" (rtos rad) ">: ") ": ")
)))(rad)))
(initget 1 "H V")
(setq dir (getkword "\nEnter Option:/ Horizontal/Vertical]: "))
(setq ang (if (eq dir "H")
'(0 pi)
'((/ pi 2.0) (* pi 1.5))
)
)
(foreach p pts
(command "_break"
(polar p (setq fa (eval (car ang))) rad)
(polar p (setq ea (eval (cadr ang))) rad)
)
(setq carc (arc p rad fa ea))
)
(*error* "")
(princ)
)
页:
[1]