[求助]点取自动产生垂直线
<p>因为是找人编程，我就用程序话的语言来表达自己的意思</p><p>1 点取多义线A（A炸开后为短直线）</p><p>2 群选线B（为直线或园弧，分别为线B1，B2，B3，。。。。。。）</p><p>3 输入长度C</p><p>4 在A或其延长线上与B（包括B1，B2，B3，。。。。。。）的交点上插入直线D（包括D1，D2，D3，。。。。。。）</p><p> D要求图层与B（包括B1，B2，B3，。。。。。。）相同，并且与A（A炸开后为短直线）垂直，插入点为D（包括D1，D2，D3，。。。。。。）之中点</p><p> </p><p>4 删除B（包括B1，B2，B3，。。。。。。）<br/></p> (defun c:test(/ ANGA ANGD DXFA ENTA ENTB I J LAYERD OBJA OBJB OBJD PTED PTMD PTSA PTSAB PTSD SPC SSB X TmpDstC)(vl-load-com)
(setq spc (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
(while (setq EntA (entsel "\n选择短直线A或空选退出: "))
(setq DxfA (entget (car EntA))
PtsA nil
)
(if (= (cdr (assoc 0 DxfA)) "LWPOLYLINE")
(progn
(mapcar '(lambda(x) (if (= (car x) 10) (setq PtsA (append PtsA (list (cdr x))))))DxfA)
(if (= (length PtsA) 2)
(progn
(setq AngA (angle (car PtsA)(cadr PtsA))
AngD (+ AngA (/ pi 2))
)
(prompt "\n选择对象B: ")
(if (setq SSB (ssget '((0 . "LINE,ARC"))))
(progn
(if (<= DstC 0) (setq DstC 1))
(setq TmpDstC (getdist (strcat "\n输入长度C: <" (rtos DstC) "> ")))
(if (> TmpDstC 0) (setq DstC TmpDstC))
(setq i 0)
(repeat (sslength SSB)
(setq EntB (ssname SSB i)
objB (vlax-ename->vla-object EntB)
objA (vlax-ename->vla-object (car EntA))
PtsAB (vlax-invoke objA 'IntersectWith objB acExtendThisEntity)
j 0
LayerD (vla-get-layer objB)
)
(repeat (/ (length PtsAB) 3)
(setq PtMD (list (nth j PtsAB) (nth (+ j 1) PtsAB)(nth (+ j 2) PtsAB))
PtSD (polar PtMD AngD (/ DstC 2))
PtED (polar PtMD (+ AngD pi) (/ DstC 2))
objD (vla-addline spc (vlax-3d-point PtSD) (vlax-3d-point PtED))
j (1+ j)
)
(vla-put-layer objD LayerD)
)
(vla-erase objB)
(setq i (1+ i))
)
)
)
)
)
)
)
)
(princ)
)
页:
[1]