求一个能画出三拐封闭多段线的lsp，求大神指导

362928018

各位大神，现已有能画出两拐的代码，现想画出三拐的图元，该如何更改？有大神赐教下吗？，谢谢
两转的代码如下：
;转角----------------------------------------------------------------------
(defun c:3C (/ OLDOS p0 p1 P2 P3 P4 P5 p0x p0y p2x p2y x02i y02i pc tTmax);测量BC作文本
(COMMAND "UNDO" "BE")
(SETQ OLDOS(GETVAR "OSMODE"))
(SETQ OLDLN (GETVAR "CLAYER"))
(initget 1)
(setq p0 (getpoint "\nFirst Point:"))
(initget 33)
(setq p1 (getPOINT p0 "\nSecond Point:"))
(initget 33)
(setq p2 (getPOINT p1 "\nThird Point:"))
(SETQ P3 (POLAR P2 (- (ANGLE P1 P2) (/ PI 2)) 100))
(SETQ P5 (POLAR P0 (- (ANGLE P0 P1) (/ PI 2)) 100))
(SETQ P4 (INTERS P3 (POLAR P3 (ANGLE P2 P1) 65) P5 (POLAR P5 (ANGLE P0 P1) 65) NIL))
(SETQ p0x (NTH 0 P0))
(SETQ p0y (NTH 1 P0))
(SETQ p2x (NTH 0 P2))
(SETQ p2y (NTH 1 P2))
(SETQ x02i (- p2x p0x))
(SETQ y02i (- p2y p0y))
(SETQ ANG1 (ANGLE P0 P1))
(SETQ ANG2 (ANGLE P1 P2))
(SETQ DIST1 (distance p0 p1))
(SETQ DIST2 (distance p1 p2))
(if (and p0 p1 P2)
(progn
(setq ttmax (STRCAT "3C " (RTOS (distance p0 p1) 2 0) "+" (RTOS (distance p1 p2) 2 0)))
(SETVAR "OSMODE" 0)
(command "layer""m""03-LC" "c" "7" "03-LC" "")
(COMMAND "PLINE" P0 P1 P2 P3 P4 P5 "C")
(command "layer""m""03-LC-word" "c" "4" "03-LC-word" "")
(if (> (abs DIST1) (abs DIST2))
(PROGN
(setq pc (polar p0 (angle p0 p4) (/ (distance p0 p4) 2)))
(COMMAND "TEXT" "j" "m" pc "50" (* (/ ANG1 PI) 180) tTmax)
)
(PROGN
(setq pc (polar p4 (angle p4 p2) (/ (distance p4 p2) 2)))
(COMMAND "TEXT" "j" "m" pc "50" (* (/ ANG2 PI) 180) tTmax)
)
)
)
)
(SETVAR "OSMODE" OLDOS)
(SETVAR "CLAYER" OLDLN)
(COMMAND "UNDO" "E")
(PRINC)
)

bzhyong

362928018 发表于 2017-12-6 22:47
高手啊，好厉害，能不能改下，
出来的图元是内侧的尺寸，能否变成外侧红色标注的尺寸？ 附图

2. 
   
3. (defun c:3C ( / OLDOS p0 p1 P2 P3 P4 P5 p6 p7 p8 p0x p0y p2x p2y x02i y02i pc tTmax)
   
4. (COMMAND "UNDO" "BE")
   
5. (SETQ OLDOS(GETVAR "OSMODE"))
   
6. (SETQ OLDLN (GETVAR "CLAYER"))
   
7. (initget 1)
   
8. (setq p0 (getpoint "\n指定第一个点:"))
   
9. (initget 33)
   
10. (setq p1 (getPOINT p0 "\n指定第二个点:"))
    
11. (initget 33)
    
12. (setq p2 (getPOINT p1 "\n指定第三个点:"))
    
13. (initget 33);设定下次getxxx函数的有效输入
    
14. (setq p3 (getPOINT p2 "\n指定第四个点:"))
    
15. 
    
16. (SETQ P4 (POLAR P3    (ANGLE P2 P1)   100))
    
17. (SETQ P7 (POLAR P0 (ANGLE P2 P1)  100))
    
18.   (setq p6 (polar p7  (ANGLE P0 P1) (+ 100
    
19.                                                    (sqrt
    
20.                                                      (+
    
21.                                                        (*(- (nth 0 p0) (nth 0 p1))
    
22.                                                          (- (nth 0 p0) (nth 0 p1))
    
23.                                                          )
    
24.                                                        (*(- (nth 1 p0) (nth 1 p1))
    
25.                                                          (- (nth 1 p0) (nth 1 p1))
    
26.                                                          )
    
27.                                                        )
    
28.                                                      )
    
29.                                                    )))
    
30.   (setq p5 (polar p6 (ANGLE P1 P2)  (sqrt
    
31.                                                      (+
    
32.                                                        (*(- (nth 0 p2) (nth 0 p1))
    
33.                                                          (- (nth 0 p2) (nth 0 p1))
    
34.                                                          )
    
35.                                                        (*(- (nth 1 p2) (nth 1 p1))
    
36.                                                          (- (nth 1 p2) (nth 1 p1))
    
37.                                                          )
    
38.                                                        )
    
39.                                                      )
    
40.                                                    ))
    
41.   ;新增p8变量是为了给文字起点到左边
    
42.   (SETQ P8 (POLAR P4    PI   2000))
    
43. ;(SETQ P4 (INTERS P3 (POLAR P3 (ANGLE P2 P1) 65) P5 (POLAR P5 (ANGLE P0 P1) 75) NIL))
    
44. ;(inters 1 2 3 4 模式)取得两条线的交点
    
45. (SETQ p0x (NTH 0 P0))
    
46. (SETQ p0y (NTH 1 P0))
    
47. (SETQ p2x (NTH 0 P2))
    
48. (SETQ p2y (NTH 1 P2))
    
49. (SETQ x02i (- p2x p0x))
    
50. (SETQ y02i (- p2y p0y))
    
51. (SETQ ANG1 (ANGLE P0 P1))
    
52. (SETQ ANG2 (ANGLE P1 P2))
    
53. (SETQ DIST1 (distance p0 p1))
    
54. (SETQ DIST2 (distance p1 p2))
    
55. (if (and p0 p1 P2)
    
56. (progn
    
57. (setq ttmax (STRCAT "4C " (RTOS (distance p0 p1) 2 0) "+" (RTOS (distance p1 p2) 2 0) "+" (RTOS (distance p2 p3) 2 0)))
    
58. (SETVAR "OSMODE" 0)
    
59. (command "layer""m""03-LC" "c" "7" "03-LC" "")
    
60. (COMMAND "PLINE" P0 P1 P2 P3 P4 P5 p6 p7 "C")
    
61. ;以下程序用来新建一个红色图层，然后在红色图层上面标注
    
62. (command "layer""m""03-LC-dim" "c" "1" "03-LC-dim" "")
    
63. (command "dimlinear" p0 p1 (POLAR P0 (ANGLE P1 P2)  500))
    
64. (command "dimlinear" p2 p1 (POLAR P1 (ANGLE P1 P0)  500))
    
65. (command "dimlinear" p2 p3 (POLAR P2 (ANGLE P1 P2)  500))
    
66. (command "dimlinear" p4 p5 (POLAR P4 (ANGLE P3 P4)  500))
    
67. (command "dimlinear" p5 p6 (POLAR P5 (ANGLE P5 P4)  500))
    
68. (command "dimlinear" p6 p7 (POLAR P6 (ANGLE P5 P6)  500))
    
69. (command "layer""m""03-LC-word" "c" "4" "03-LC-word" "")
    
70. (if (> (abs DIST1) (abs DIST2))
    
71. (PROGN
    
72. (setq pc (polar p0 (angle p0 p4) (/ (distance p0 p4) 2)))
    
73. (COMMAND "TEXT" p8 "50"
    
74.          "0"
    
75.          tTmax)
    
76. )
    
77. (PROGN
    
78. (setq pc (polar p4 (angle p4 p2) (/ (distance p4 p2) 2)))
    
79. (COMMAND "TEXT" p8 "50"
    
80.          "0"
    
81.          tTmax)
    
82. )
    
83. )
    
84. )
    
85. )
    
86.   
    
87. (SETVAR "OSMODE" OLDOS)
    
88. (SETVAR "CLAYER" OLDLN)
    
89. (COMMAND "UNDO" "E")
    
90. (PRINC)
    
91. )

<br /> (defun c:3C ( / OLDOS p0 p1 P2 P3 P4 P5 p6 p7 p8 p0x p0y p2x p2y x02i y02i pc tTmax)<br /> (COMMAND "UNDO" "BE")<br /> (SETQ OLDOS(GETVAR "OSMODE"))<br /> (SETQ OLDLN (GETVAR "CLAYER"))<br /> (initget 1)<br /> (setq p0 (getpoint "\n指定第一个点:"))<br /> (initget 33)<br /> (setq p1 (getPOINT p0 "\n指定第二个点:"))<br /> (initget 33)<br /> (setq p2 (getPOINT p1 "\n指定第三个点:"))<br /> (initget 33);设定下次getxxx函数的有效输入<br /> (setq p3 (getPOINT p2 "\n指定第四个点:"))<br /> <br /> (SETQ P4 (POLAR P3    (ANGLE P2 P1)   100))<br /> (SETQ P7 (POLAR P0 (ANGLE P2 P1)  100))<br />   (setq p6 (polar p7  (ANGLE P0 P1) (+ 100<br />                                                    (sqrt<br />                                                      (+<br />                                                        (*(- (nth 0 p0) (nth 0 p1))<br />                                                          (- (nth 0 p0) (nth 0 p1))<br />                                                          )<br />                                                        (*(- (nth 1 p0) (nth 1 p1))<br />                                                          (- (nth 1 p0) (nth 1 p1))<br />                                                          )<br />                                                        )<br />                                                      )<br />                                                    )))<br />   (setq p5 (polar p6 (ANGLE P1 P2)  (sqrt<br />                                                      (+<br />                                                        (*(- (nth 0 p2) (nth 0 p1))<br />                                                          (- (nth 0 p2) (nth 0 p1))<br />                                                          )<br />                                                        (*(- (nth 1 p2) (nth 1 p1))<br />                                                          (- (nth 1 p2) (nth 1 p1))<br />                                                          )<br />                                                        )<br />                                                      )<br />                                                    ))<br />   ;新增p8变量是为了给文字起点到左边<br />   (SETQ P8 (POLAR P4    PI   2000))<br /> ;(SETQ P4 (INTERS P3 (POLAR P3 (ANGLE P2 P1) 65) P5 (POLAR P5 (ANGLE P0 P1) 75) NIL))<br /> ;(inters 1 2 3 4 模式)取得两条线的交点<br /> (SETQ p0x (NTH 0 P0))<br /> (SETQ p0y (NTH 1 P0))<br /> (SETQ p2x (NTH 0 P2))<br /> (SETQ p2y (NTH 1 P2))<br /> (SETQ x02i (- p2x p0x))<br /> (SETQ y02i (- p2y p0y))<br /> (SETQ ANG1 (ANGLE P0 P1))<br /> (SETQ ANG2 (ANGLE P1 P2))<br /> (SETQ DIST1 (distance p0 p1))<br /> (SETQ DIST2 (distance p1 p2))<br /> (if (and p0 p1 P2)<br /> (progn<br /> (setq ttmax (STRCAT "4C " (RTOS (distance p0 p1) 2 0) "+" (RTOS (distance p1 p2) 2 0) "+" (RTOS (distance p2 p3) 2 0)))<br /> (SETVAR "OSMODE" 0)<br /> (command "layer""m""03-LC" "c" "7" "03-LC" "")<br /> (COMMAND "PLINE" P0 P1 P2 P3 P4 P5 p6 p7 "C")<br /> ;以下程序用来新建一个红色图层，然后在红色图层上面标注<br /> (command "layer""m""03-LC-dim" "c" "1" "03-LC-dim" "")<br /> (command "dimlinear" p0 p1 (POLAR P0 (ANGLE P1 P2)  500))<br /> (command "dimlinear" p2 p1 (POLAR P1 (ANGLE P1 P0)  500))<br /> (command "dimlinear" p2 p3 (POLAR P2 (ANGLE P1 P2)  500))<br /> (command "dimlinear" p4 p5 (POLAR P4 (ANGLE P3 P4)  500))<br /> (command "dimlinear" p5 p6 (POLAR P5 (ANGLE P5 P4)  500))<br /> (command "dimlinear" p6 p7 (POLAR P6 (ANGLE P5 P6)  500))<br /> (command "layer""m""03-LC-word" "c" "4" "03-LC-word" "")<br /> (if (> (abs DIST1) (abs DIST2))<br /> (PROGN<br /> (setq pc (polar p0 (angle p0 p4) (/ (distance p0 p4) 2)))<br /> (COMMAND "TEXT" p8 "50"<br />          "0"<br />          tTmax)<br /> )<br /> (PROGN<br /> (setq pc (polar p4 (angle p4 p2) (/ (distance p4 p2) 2)))<br /> (COMMAND "TEXT" p8 "50"<br />          "0"<br />          tTmax)<br /> )<br /> )<br /> )<br /> )<br />   <br /> (SETVAR "OSMODE" OLDOS)<br /> (SETVAR "CLAYER" OLDLN)<br /> (COMMAND "UNDO" "E")<br /> (PRINC)<br /> )

bzhyong

(defun c:3C ( / OLDOS p0 p1 P2 P3 P4 P5 p0x p0y p2x p2y x02i y02i pc tTmax)
(COMMAND "UNDO" "BE")
(SETQ OLDOS(GETVAR "OSMODE"))
(SETQ OLDLN (GETVAR "CLAYER"))
(initget 1)
(setq p0 (getpoint "\n指定第一个点:"))
(initget 33)
(setq p1 (getPOINT p0 "\n指定第二个点:"))
(initget 33)
(setq p2 (getPOINT p1 "\n指定第三个点:"))
(initget 33);设定下次getxxx函数的有效输入
(setq p3 (getPOINT p2 "\n指定第四个点:"))

(SETQ P4 (POLAR P3    (ANGLE P2 P1)   100))
(SETQ P7 (POLAR P0 (ANGLE P2 P1)  100))
  (setq p6 (polar p7  (ANGLE P0 P1) (+ 100
                                                   (sqrt
                                                     (+
                                                       (*(- (nth 0 p0) (nth 0 p1))
                                                         (- (nth 0 p0) (nth 0 p1))
                                                         )
                                                       (*(- (nth 1 p0) (nth 1 p1))
                                                         (- (nth 1 p0) (nth 1 p1))
                                                         )
                                                       )
                                                     )
                                                   )))
  (setq p5 (polar p6 (ANGLE P1 P2)  (sqrt
                                                     (+
                                                       (*(- (nth 0 p2) (nth 0 p1))
                                                         (- (nth 0 p2) (nth 0 p1))
                                                         )
                                                       (*(- (nth 1 p2) (nth 1 p1))
                                                         (- (nth 1 p2) (nth 1 p1))
                                                         )
                                                       )
                                                     )
                                                   ))
;(SETQ P4 (INTERS P3 (POLAR P3 (ANGLE P2 P1) 65) P5 (POLAR P5 (ANGLE P0 P1) 75) NIL))
;(inters 1 2 3 4 模式)取得两条线的交点
(SETQ p0x (NTH 0 P0))
(SETQ p0y (NTH 1 P0))
(SETQ p2x (NTH 0 P2))
(SETQ p2y (NTH 1 P2))
(SETQ x02i (- p2x p0x))
(SETQ y02i (- p2y p0y))
(SETQ ANG1 (ANGLE P0 P1))
(SETQ ANG2 (ANGLE P1 P2))
(SETQ DIST1 (distance p0 p1))
(SETQ DIST2 (distance p1 p2))
(if (and p0 p1 P2)
(progn
(setq ttmax (STRCAT "4C " (RTOS (distance p0 p1) 2 0) "+" (RTOS (distance p1 p2) 2 0) "+" (RTOS (distance p2 p3) 2 0)))
(SETVAR "OSMODE" 0)
(command "layer""m""03-LC" "c" "7" "03-LC" "")
(COMMAND "PLINE" P0 P1 P2 P3 P4 P5 p6 p7 "C")
(command "layer""m""03-LC-word" "c" "4" "03-LC-word" "")
(if (> (abs DIST1) (abs DIST2))
(PROGN
(setq pc (polar p0 (angle p0 p4) (/ (distance p0 p4) 2)))
(COMMAND "TEXT" "j" "m" pc "50" (* (/ ANG1 PI) 180) tTmax)
)
(PROGN
(setq pc (polar p4 (angle p4 p2) (/ (distance p4 p2) 2)))
(COMMAND "TEXT" "j" "m" pc "50" (* (/ ANG2 PI) 180) tTmax)
)
)
)
)
(SETVAR "OSMODE" OLDOS)
(SETVAR "CLAYER" OLDLN)
(COMMAND "UNDO" "E")
(PRINC)
)

362928018

bzhyong 发表于 2017-12-6 14:10
我也是刚开始学习。弄了三四个小时才弄好，希望能帮到你

高手啊，好厉害，能不能改下，
出来的图元是内侧的尺寸，能否变成外侧红色标注的尺寸？ 附图

362928018

有大神帮忙优化下吗

362928018

362928018 发表于 2017-12-1 09:36
有大神帮忙优化下吗

谢谢xyp1964版主的解答，我初学LISP，好多看不懂，能帮忙修改下吗？

xyp1964

362928018 发表于 2017-12-2 16:00
谢谢xyp1964版主的解答，我初学LISP，好多看不懂，能帮忙修改下吗？

;; 也许是你的意思

362928018

xyp1964 发表于 2017-12-2 19:40
;; 也许是你的意思

命令: TT ; 错误: no function definition: XYP-STARTSC  提示错误，用不了，能再看看是哪里出问题吗？

362928018

xyp1964 发表于 2017-12-2 19:40
;; 也许是你的意思

能在之前我提供的加入第四点的代码吗？

bzhyong

我也是刚开始学习。弄了三四个小时才弄好，希望能帮到你