[原创]：画矩形中心线LISP

fengjunchina

非常不成熟的，谁帮我改改！让它能一次绘制出矩形中心线！！！


[PHP]
;Locked by  China. 2005-2006 第二版
(defun C:rcen ( / rr rr0 rr1 rr2 rr3 rr4 a b le se f g h i j zz)
(princ "\n欢迎使用矩形中心线制程序第二版!")
  (setq oldecho (getvar "cmdecho"))
  (setq oldsnap (getvar "osmode"))
(setvar "osmode" 1)
(setq rr1 (getpoint "\n第一点：")) ;选择一个图元
(setq rr2 (getpoint "\n第二点(第一点的对角点)："))
(setq rr3 (getpoint "\n第三点(第二点最近的一个点)："))
(setq rr4 (getpoint "\n第四点(第二点的对角点)："))
(setq jd (inters rr1 rr2 rr3 rr4))
(setq rr (getpoint "\n伸出矩形外长度第一点："))
(setq rr0 (getpoint "\n伸出矩形外长度第二点："))
(setq zz (distance rr rr0))
(setq a1 (angle rr1 rr3))
(setq a2 (angle rr1 rr4))
(setq a (distance rr1 rr3))
(setq b (distance rr1 rr4))
(setq le (+ (/ (max a b) 2) zz))
(setq se (+ (/ (min a b) 2) zz))
(setq g (polar jd a1 le))
(setq h (polar jd a1 (- le)))
(setq i (polar jd a2 se))
(setq j (polar jd a2 (- se)))
  (setq oldlayer (getvar "clayer"))
(if (= nil (tblsearch"layer" "3"))

(command "-layer" "n" "3" "c" "1" "3" "lt" "center2" "3" "")

)
  (setvar "clayer" "3")

(command "line" g h "")
(command "line" i j "")
;(setq rr nil rr0 nil rr1 nil rr2 nil rr3 nil rr4 nil a nil b nil le nil se nil f nil g nil h nil i nil j nil zz nil)
(princ "\n已经为你画完矩形的中心线，谢谢使用!")
  (setvar "cmdecho" oldecho)
  (setvar "osmode" oldsnap)
  (setvar "clayer" oldlayer)
(princ)
)
[/PHP]

cy956

看看dxf部分，应该是选择一条(矩形)的pl线，
判断是否矩形（比如四个顶点，相邻垂直之类）
然后就根据边线的方向、长度自动画上中心线。

如果是用line形成的矩形，一种可以用头尾搜索找到边，
一种就是你这样。

不过应该只用输入三个点就可以求了。

zxdvip

运行太麻烦，一百个矩形怎么办呢？

carrot1983

手痒，写了一个。。。也请高手们修改修改。。。

2. 
   
3. ;;;通用函数 carrot1983.2007-12-12
   
4. (vl-load-com)
   
5. ;;ss->elst选择集->图元表
   
6. (defun ss->elst        (ss / elst)
   
7.   (setq i 0)
   
8.   (repeat (sslength ss)
   
9.     (setq elst (cons (ssname ss i) elst)
   
10.           i    (1+ i)
    
11.     )
    
12.   )
    
13.   (reverse elst)
    
14. )
    
15. 
    
16. ;;;按顺序取得曲线的点
    
17. (defun jw-get-plst (E / I O PLST)
    
18.   (setq        o    (vlax-ename->vla-object e)
    
19.         i    1
    
20.         plst nil
    
21.   )
    
22.   (repeat 100
    
23.     (if        (and o (setq p (vlax-curve-getPointAtParam o i)))
    
24.       (setq plst (cons p plst)
    
25.             i         (1+ i)
    
26.       )
    
27.       (setq o nil)
    
28.     )
    
29.   )
    
30.   plst
    
31. )
    
32. 
    
33. ;;;写线jw-make-line
    
34. (defun jw-make-line (v10 v11)
    
35.   (entmake (list (cons 0 "LINE")
    
36.                  (cons 6 "BYLAYER")
    
37.                  (cons 8 "0")
    
38.                  (cons 10 v10)
    
39.                  (cons 11 v11)
    
40.                  (cons 39 0.0)
    
41.                  (cons 62 256)
    
42.                  (cons 210 (list 0.0 0.0 1.0))
    
43.            )
    
44.   )
    
45. )
    
46. 
    
47. ;;;中点jw-mid-p
    
48. (defun jw-mid-p        (a b)
    
49.   (mapcar
    
50.     '(lambda (a b) (/ (+ a b) 2))
    
51.     a
    
52.     b
    
53.   )
    
54. )
    
55. 
    
56. ;;;中点表jw-mid-plst
    
57. (defun jw-mid-plst (E DIS / ANG13 ANG24 DIS1 DIS2 P1 P2 P3 P4 PLST)
    
58.   (setq plst (jw-get-plst e))
    
59.   (setq        p1 (mid-p (nth 0 plst) (nth 1 plst))
    
60.         p2 (mid-p (nth 1 plst) (nth 2 plst))
    
61.         p3 (mid-p (nth 2 plst) (nth 3 plst))
    
62.         p4 (mid-p (nth 3 plst) (nth 0 plst))
    
63.   )
    
64.   (setq        ang13 (angle p1 p3)
    
65.         ang24 (angle p2 p4)
    
66.   )
    
67.   (setq        dis1 dis
    
68.         dis2 dis
    
69.   )
    
70.   (setq        p1 (polar p1 (+ ang13 pi) dis1)
    
71.         p2 (polar p2 (+ ang24 pi) dis2)
    
72.         p3 (polar p3 ang13 dis1)
    
73.         p4 (polar p4 ang24 dis2)
    
74.   )
    
75.   (setq plst (list p1 p2 p3 p4))
    
76. )
    
77. 
    
78. 
    
79. ;;;主程序：tt画矩形中心线carrot1983.2007-12-12
    
80. (defun c:tt (/ ELST SS D E I PLST)
    
81.   (if (setq ss (ssget '((0 . "*POLYLINE"))))
    
82.     (progn
    
83.       (setq elst (ss->elst ss))
    
84.       (if (setq d (getdist "\n指定伸出矩形外长度<100>"))
    
85.         d
    
86.         (setq d 100)
    
87.       )
    
88.       (foreach e elst
    
89.         (setq plst (jw-mid-plst e d))
    
90.         (jw-make-line (nth 0 plst) (nth 2 plst))
    
91.         (jw-make-line (nth 1 plst) (nth 3 plst))
    
92.       )
    
93.     )
    
94.     (alert "\n请重新选择!")
    
95.   )
    
96.   (princ)
    
97. )
    
98. 
    

<br /> ;;;通用函数 carrot1983.2007-12-12<br /> (vl-load-com)<br /> ;;ss->elst选择集->图元表<br /> (defun ss->elst        (ss / elst)<br />   (setq i 0)<br />   (repeat (sslength ss)<br />     (setq elst (cons (ssname ss i) elst)<br />           i    (1+ i)<br />     )<br />   )<br />   (reverse elst)<br /> )<br /> <br /> ;;;按顺序取得曲线的点<br /> (defun jw-get-plst (E / I O PLST)<br />   (setq        o    (vlax-ename->vla-object e)<br />         i    1<br />         plst nil<br />   )<br />   (repeat 100<br />     (if        (and o (setq p (vlax-curve-getPointAtParam o i)))<br />       (setq plst (cons p plst)<br />             i         (1+ i)<br />       )<br />       (setq o nil)<br />     )<br />   )<br />   plst<br /> )<br /> <br /> ;;;写线jw-make-line <br /> (defun jw-make-line (v10 v11)<br />   (entmake (list (cons 0 "LINE")<br />                  (cons 6 "BYLAYER")<br />                  (cons 8 "0")<br />                  (cons 10 v10)<br />                  (cons 11 v11)<br />                  (cons 39 0.0)<br />                  (cons 62 256)<br />                  (cons 210 (list 0.0 0.0 1.0))<br />            )<br />   )<br /> )<br /> <br /> ;;;中点jw-mid-p <br /> (defun jw-mid-p        (a b)<br />   (mapcar<br />     '(lambda (a b) (/ (+ a b) 2))<br />     a<br />     b<br />   )<br /> )<br /> <br /> ;;;中点表jw-mid-plst <br /> (defun jw-mid-plst (E DIS / ANG13 ANG24 DIS1 DIS2 P1 P2 P3 P4 PLST)<br />   (setq plst (jw-get-plst e))<br />   (setq        p1 (mid-p (nth 0 plst) (nth 1 plst))<br />         p2 (mid-p (nth 1 plst) (nth 2 plst))<br />         p3 (mid-p (nth 2 plst) (nth 3 plst))<br />         p4 (mid-p (nth 3 plst) (nth 0 plst))<br />   )<br />   (setq        ang13 (angle p1 p3)<br />         ang24 (angle p2 p4)<br />   )<br />   (setq        dis1 dis<br />         dis2 dis<br />   )<br />   (setq        p1 (polar p1 (+ ang13 pi) dis1)<br />         p2 (polar p2 (+ ang24 pi) dis2)<br />         p3 (polar p3 ang13 dis1)<br />         p4 (polar p4 ang24 dis2)<br />   )<br />   (setq plst (list p1 p2 p3 p4))<br /> )<br /> <br /> <br /> ;;;主程序：tt画矩形中心线carrot1983.2007-12-12<br /> (defun c:tt (/ ELST SS D E I PLST)<br />   (if (setq ss (ssget '((0 . "*POLYLINE"))))<br />     (progn<br />       (setq elst (ss->elst ss))<br />       (if (setq d (getdist "\n指定伸出矩形外长度<100>"))<br />         d<br />         (setq d 100)<br />       )<br />       (foreach e elst<br />         (setq plst (jw-mid-plst e d))<br />         (jw-make-line (nth 0 plst) (nth 2 plst))<br />         (jw-make-line (nth 1 plst) (nth 3 plst))<br />       )<br />     )<br />     (alert "\n请重新选择!")<br />   )<br />   (princ)<br /> )<br /> <br />

lvbaoqi

绘制出矩形中心线干什么用啊，为什么要绘制出矩形中心线

carrot1983

最初由 lvbaoqi 发布
[B]绘制出矩形中心线干什么用啊，为什么要绘制出矩形中心线 [/B]

我发现四楼的代码也可以画“长螺孔”的中心线。