[求助]点取自动产生垂直线

raobinhsh

因为是找人编程，我就用程序话的语言来表达自己的意思

1 点取多义线A（A炸开后为短直线）

2 群选线B（为直线或园弧，分别为线B1，B2，B3，。。。。。。）

3 输入长度C

4 在A或其延长线上与B（包括B1，B2，B3，。。。。。。）的交点上插入直线D（包括D1，D2，D3，。。。。。。）

  D要求图层与B（包括B1，B2，B3，。。。。。。）相同，并且与A（A炸开后为短直线）垂直，插入点为D（包括D1，D2，D3，。。。。。。）之中点

 

4 删除B（包括B1，B2，B3，。。。。。。）

sailorcwx

2. (defun c:test(/ ANGA ANGD DXFA ENTA ENTB I J LAYERD OBJA OBJB OBJD PTED PTMD PTSA PTSAB PTSD SPC SSB X TmpDstC)
3.   (vl-load-com)
4.   (setq spc (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
5.   (while (setq EntA (entsel "\n选择短直线A或空选退出: "))
6.     (setq DxfA (entget (car EntA))
7.    PtsA nil
8.    )
9.     (if (= (cdr (assoc 0 DxfA)) "LWPOLYLINE")
10.       (progn
11. (mapcar '(lambda(x) (if (= (car x) 10) (setq PtsA (append PtsA (list (cdr x))))))  DxfA)
12. (if (= (length PtsA) 2)
13.    (progn
14.      (setq AngA (angle (car PtsA)(cadr PtsA))
15.     AngD (+ AngA (/ pi 2))
16.     )
17.      (prompt "\n选择对象B: ")
18.      (if (setq SSB (ssget '((0 . "LINE,ARC"))))
19.        (progn
20.   (if (<= DstC 0) (setq DstC 1))
21.   (setq TmpDstC (getdist (strcat "\n输入长度C: <" (rtos DstC) "> ")))
22.   (if (> TmpDstC 0) (setq DstC TmpDstC))
23.   (setq i 0)
24.   (repeat (sslength SSB)
25.     (setq EntB (ssname SSB i)
26.    objB (vlax-ename->vla-object EntB)
27.    objA (vlax-ename->vla-object (car EntA))
28.    PtsAB (vlax-invoke objA 'IntersectWith objB acExtendThisEntity)
29.    j 0
30.    LayerD (vla-get-layer objB)
31.    )
32.     (repeat (/ (length PtsAB) 3)
33.       (setq PtMD (list (nth j PtsAB) (nth (+ j 1) PtsAB)(nth (+ j 2) PtsAB))
34.      PtSD (polar PtMD AngD (/ DstC 2))
35.      PtED (polar PtMD (+ AngD pi) (/ DstC 2))
36.      objD (vla-addline spc (vlax-3d-point PtSD) (vlax-3d-point PtED))
37.      j (1+ j)
38.      )
39.       (vla-put-layer objD LayerD)
40.       )
41.     (vla-erase objB)
42.     (setq i (1+ i))
43.     )
44.   )
45.        )
46.      )
47.    )
48. )
49.       )
50.     )
51.   (princ)
52.   )

(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)   )