求助-求自动画两个面夹角及角平分线的lsp

feizheng

各位大虾，我LSP还未入门，能看简单的，现在遇到一个东东，需要画两个三维面的夹角（图中红色线），并画角平分线（图中紫色线），

因为每次操作要好几个步骤(转UCS及画直线)，而我有好多这样的面需要重复标的,所以求哪位能帮忙编个lsp，这样每次只需要选择四个点，相关的三条线就通过LSP来画。

先谢谢了。

ljpnb

一直以来只处理二维的问题,对三维了解很少,程序也未作优化,对点的处理一定有更简单的方法.程序基本能实现要求.....

feizheng

谢谢ljpnb,辛苦你了。

功能基本能实现了，可以画两条垂直于面的交线的直线了，但好像角平分线没有画。

还有就是运行这个lsp之前好像要把坐标改为世界坐标，否则直线会跑掉。

呵呵，比我想象中的程序长。

ljpnb

feizheng 发表于 2011-7-10 00:52
谢谢ljpnb,辛苦你了。

功能基本能实现了，可以画两条垂直于面的交线的直线了，但好像角平分线没有画。

修改过了,你再试试....

feizheng

谢谢，功能完全实现了，可以画角平分线了。试了一下，旋转坐标后也线不会跑了。


继续探讨，因组成两个面的不一定是直线，可能是多义线或多面网格，所以我之前的想法是利用直线上点来画：
1. 三点确定UCS,依次选1，2，3三个点 ,再以点1为端点，Y向为正向画直线。
2. 三点确定UCS,依次选1，2，4三个点 ,再以点1为端点，Y向为正向画直线。
3. 三点确定UCS,依次选点1和刚刚两条直线上的点 ,再以点1为端点，角平分线方向画直线
（或者是刚刚两个直线的端点连线的中点到点1画线）。

第1，2部感觉可以用下面类似的lsp实现，但下面这个是拿别的改的，语法什么的不对，运行不了。

(DEFUN C:aa(/ hp1 hp2 hp3 hp4 )
  (SETQ hp1 (GETPOINT "\nFirst Point :")
         hp2 (GETPOINT "\nSecond Point :")
           hp3 (GETPOINT "\nthird Point :")
             hp4 (GETPOINT "\nforth Point :")
)

(command ".ucs" "_3" hp1 hp2 hp3 "")
(COMMAND "line" hp1 "500" "")
(command ".ucs" "_3" hp1 hp2 hp4 "")
(COMMAND "line" hp1 "-500" "")
(PRINC)
)

sunnylhj

我给你发一个！最好能帮我改改代码也发给我一份！我之前也一直找这个，但总找不到，但自己又是菜鸟，只有自己乱搞了一个！使用方法是：选择1、2、3、4就画出角度了！使用之前最好用 ST 命令设置一下文字样式，要不然运行出错！ （代码里面有一些可能你用不到，你就直接删除掉吧！ ）

1. (defun midpoint (m1 m2)
   
2.   (setq ptx (+ (nth 0 m1) (/ (- (nth 0 m2) (nth 0 m1)) 2 )))
   
3.   (setq pty (+ (nth 1 m1) (/ (- (nth 1 m2) (nth 1 m1)) 2 )))
   
4.   (setq ptz (+ (nth 2 m1) (/ (- (nth 2 m2) (nth 2 m1)) 2 )))
   
5.   (list ptx pty ptz)
   
6.   )
   
7. (defun wtu (pt)
   
8.   (trans pt 0 1)
   
9.   )
   
10. (defun utw (pt)
    
11.   (trans pt 1 0)
    
12.   )
    
13. 
    
14. (defun c:2mj (/ pt1 pt2 pt3 pt4 mpt mp1 mpt-a sp ep mp ang ang1 dang  )
    
15.   (command "ucs" "na" "d" "oucs"
    
16.            "ucs" "na" "s" "oucs"
    
17.            "ucs" "w")
    
18.   (setq oldos (getvar "osmode"))
    
19.   (setvar "osmode" 1025)
    
20.   (setq pt1 (getpoint "\nPlease select AXIS point1:")
    
21.         pt2 (getpoint "\nPlease select AXIS point2:")
    
22.         pt3 (getpoint "\nPlease select point3:")
    
23.         pt4 (getpoint "\nPlease select point4:")
    
24.     ;mpt (midpoint pt1 pt2)
    
25.     )
    
26.   (setvar "osmode" 0)
    
27.   (setq mpt (midpoint pt1 pt2) )
    
28.   ;(setq mpt (polar pt1 (angle pt1 pt2) (* 0.5 (distance pt1 pt2))))  
    
29.   
    
30.   (setq hfp (* 0.2 (distance pt1 mpt)))
    
31.   (command "ucs" "3p"  pt1 pt2 pt3 )
    
32.   (setq L1 (strcat "@" (rtos hfp) "<-90"))
    
33.   (setq Line_1 (ssadd))
    
34.   (command "line" (wtu pt3) L1 "")
    
35.   (ssadd (entlast) Line_1)
    
36.   (setq ent1 (entget (ssname Line_1 0)))
    
37.   (setq mp1 (trans (cdr (assoc 11 ent1)) 0 1))
    
38.   (setq mpt-a (wtu mpt ))
    
39.   (command "move" Line_1 "" mp1 mpt-a)
    
40.   (command "ucs" "w"
    
41.            "ucs" "3p" pt1 pt2 pt4
    
42.        )
    
43.   (setq Line_2 (ssadd))
    
44.   (command "line" (wtu pt4 ) L1 "")
    
45.   (ssadd (entlast) Line_2)
    
46.   (setq ent2 (entget (ssname Line_2 0)))
    
47.   (setq mp2 (wtu (cdr (assoc 11 ent2)) ))
    
48.   (command "move" Line_2 "" mp2 mpt-a)
    
49.   ;(setvar "osmode" oldos)
    
50. 
    
51.   (command "ucs" "ob" Line_1
    
52.            "ucs" "x" "-90")
    
53.   (command "Pedit" Line_2 "y" "j" Line_1 "" "x")
    
54.   (command "ucs" "w" )
    
55.   (setq ent (entlast))
    
56.   (setq sp (wtu (vlax-curve-getStartPoint ent))
    
57.         ep (wtu (vlax-curve-getEndPoint  ent))
    
58.       ;mp mpt
    
59.       dd1 (* 0.5 hfp)
    
60.     )
    
61.   ;(command "line" sp ep "")
    
62.   (command "ucs" "3p" sp ep mpt)
    
63.   (setq di (* 0.5 (distance sp ep))
    
64.         mdn (list di 0 0)
    
65.     )      
    
66.   (command "ucs" "n" (setq mdn (list di 0 0)))
    
67.   (command "line" "0,0" (wtu mpt) "")
    
68.   
    
69.   (setq test_point (nth 1 (wtu mpt)))  
    
70.   (if (< test_point 0)
    
71.       (setq fx "@0,50")
    
72.     (setq fx "@0,-50")
    
73.     )  
    
74. 
    
75. ;  (setq nmd (polar sp (angle sp ep) (* 0.5 (distance sp ep))))
    
76. ;  (command "point" nmd)
    
77. ;  (command "line" mp nmd "")
    
78. 
    
79. (if (> (nth 1 (getvar "ucsydir" ) ) 0)   
    
80.   (command "ucs" "x" "180")   
    
81.   )
    
82. 
    
83. (command "DIMANGULAR" "" (wtu mpt) (wtu ep) (wtu sp)  fx)
    
84.   (setq jd (entlast))
    
85.   (setq angle_data (atof (angtos (vla-get-measurement (vlax-ename->vla-object jd)))))
    
86. 
    
87.   (if (> angle_data 180)
    
88.       (setq angle_data1 (strcat "O corner:" (rtos angle_data 2 2)  "%%D"))
    
89.     (setq angle_data1 (strcat "I corner:" (rtos angle_data 2 2)  "%%D"))
    
90.     )
    
91.   
    
92. ;  (if (> angle_data 180)
    
93. ;      (progn
    
94. ;        (setq angle_data (- angle_data 180))
    
95. ;      (setq angle_data (- 180 angle_data))
    
96. ;    )
    
97. ;    (setq angle_data (atof (angtos (vla-get-measurement (vlax-ename->vla-object jd)))))
    
98. ;    )
    
99. ;    (command "text" "j" "mc" "0,0" "0" angle_data1 )
    
100. ;  (command "erase" ent jd "")
     
101. ;  (command "erase"  jd "")
     
102. 
     
103. ;(setq f (open "c:\\temp\\angle.csv " "a"))
     
104. (if (= f nil)
     
105.   (alert "C:\Temp\angle.csv 被其他程序打開,請關閉再試!!!")
     
106. )
     
107. 
     
108. ;(write-line (rtos angle_data 2 2) f)
     
109. (setq list1 (append list1 (list angle_data)))
     
110. (setq max_1 (apply 'max list1))
     
111. (setq min_1 (apply 'min list1))
     
112. (princ (strcat "\nMax Angle: " (rtos max_1) "°" "       Min Angle: " (rtos min_1) "°"))
     
113. 
     
114. 
     
115. ;  (setq vla-ent (vlax-ename->vla-object ent))
     
116. 
     
117.   ;(command "ucs" "W")
     
118.   (setvar "osmode" oldos)
     
119.   (princ)
     
120.   )
     
121. 
     
122.   (defun prt (/ p1a p2a p3a p4a)
     
123.       (setq P1a "PT1" P2a "PT2" P3a "PT3" P4a "PT4" M4 "MPT12")
     
124.       (command
     
125.              "text" "j" "mc" (trans PT1 0 1) "0" p1a PT1
     
126.          "text" "j" "mc" (trans PT2 0 1) "0" p2a PT2
     
127.          "text" "j" "mc" (trans PT3 0 1) "0" p3a PT3
     
128.          "text" "j" "mc" (trans PT4 0 1) "0" p4a PT4
     
129.          "text" "j" "mc" (trans MPT12 0 1) "0" M4 MPT12
     
130.          ;(command "-MTEXT" PT1 "H" "10" "W" "0" P1a PT1 ""
     
131.           ;        "-MTEXT" PT2 "H" "10" "W" "0" P2a PT2 ""
     
132.         ;    "-MTEXT" PT3 "H" "10" "W" "0" P3a PT3 ""
     
133.         ;    "-MTEXT" PT4 "H" "10" "W" "0" P4a PT4 ""
     
134.         ;    "-MTEXT" MPT  "H" "10" "W" "0" M4 MPT ""
     
135.             )
     
136.             )

(defun midpoint (m1 m2)<br />   (setq ptx (+ (nth 0 m1) (/ (- (nth 0 m2) (nth 0 m1)) 2 )))<br />   (setq pty (+ (nth 1 m1) (/ (- (nth 1 m2) (nth 1 m1)) 2 )))<br />   (setq ptz (+ (nth 2 m1) (/ (- (nth 2 m2) (nth 2 m1)) 2 )))<br />   (list ptx pty ptz)<br />   )<br /> (defun wtu (pt)<br />   (trans pt 0 1)<br />   )<br /> (defun utw (pt)<br />   (trans pt 1 0)<br />   )<br /> <br /> (defun c:2mj (/ pt1 pt2 pt3 pt4 mpt mp1 mpt-a sp ep mp ang ang1 dang  )<br />   (command "ucs" "na" "d" "oucs"<br />            "ucs" "na" "s" "oucs"<br />            "ucs" "w")<br />   (setq oldos (getvar "osmode"))<br />   (setvar "osmode" 1025)<br />   (setq pt1 (getpoint "\nPlease select AXIS point1:")<br />         pt2 (getpoint "\nPlease select AXIS point2:")<br />         pt3 (getpoint "\nPlease select point3:")<br />         pt4 (getpoint "\nPlease select point4:")<br />     ;mpt (midpoint pt1 pt2)<br />     )<br />   (setvar "osmode" 0)<br />   (setq mpt (midpoint pt1 pt2) )<br />   ;(setq mpt (polar pt1 (angle pt1 pt2) (* 0.5 (distance pt1 pt2))))  <br />   <br />   (setq hfp (* 0.2 (distance pt1 mpt)))<br />   (command "ucs" "3p"  pt1 pt2 pt3 )<br />   (setq L1 (strcat "@" (rtos hfp) "<-90"))<br />   (setq Line_1 (ssadd))<br />   (command "line" (wtu pt3) L1 "")<br />   (ssadd (entlast) Line_1)<br />   (setq ent1 (entget (ssname Line_1 0)))<br />   (setq mp1 (trans (cdr (assoc 11 ent1)) 0 1))<br />   (setq mpt-a (wtu mpt ))<br />   (command "move" Line_1 "" mp1 mpt-a)<br />   (command "ucs" "w"<br />            "ucs" "3p" pt1 pt2 pt4<br />        )<br />   (setq Line_2 (ssadd))<br />   (command "line" (wtu pt4 ) L1 "")<br />   (ssadd (entlast) Line_2)<br />   (setq ent2 (entget (ssname Line_2 0)))<br />   (setq mp2 (wtu (cdr (assoc 11 ent2)) ))<br />   (command "move" Line_2 "" mp2 mpt-a)<br />   ;(setvar "osmode" oldos)<br /> <br />   (command "ucs" "ob" Line_1<br />            "ucs" "x" "-90")<br />   (command "Pedit" Line_2 "y" "j" Line_1 "" "x")<br />   (command "ucs" "w" )<br />   (setq ent (entlast))<br />   (setq sp (wtu (vlax-curve-getStartPoint ent))<br />         ep (wtu (vlax-curve-getEndPoint  ent))<br />       ;mp mpt<br />       dd1 (* 0.5 hfp)<br />     )<br />   ;(command "line" sp ep "")<br />   (command "ucs" "3p" sp ep mpt)<br />   (setq di (* 0.5 (distance sp ep))<br />         mdn (list di 0 0)<br />     )       <br />   (command "ucs" "n" (setq mdn (list di 0 0)))<br />   (command "line" "0,0" (wtu mpt) "")<br />   <br />   (setq test_point (nth 1 (wtu mpt)))  <br />   (if (< test_point 0)<br />       (setq fx "@0,50")<br />     (setq fx "@0,-50")<br />     )  <br /> <br /> ;  (setq nmd (polar sp (angle sp ep) (* 0.5 (distance sp ep))))<br /> ;  (command "point" nmd)<br /> ;  (command "line" mp nmd "")<br /> <br /> (if (> (nth 1 (getvar "ucsydir" ) ) 0)    <br />   (command "ucs" "x" "180")    <br />   )<br /> <br /> (command "DIMANGULAR" "" (wtu mpt) (wtu ep) (wtu sp)  fx)<br />   (setq jd (entlast))<br />   (setq angle_data (atof (angtos (vla-get-measurement (vlax-ename->vla-object jd)))))<br /> <br />   (if (> angle_data 180)<br />       (setq angle_data1 (strcat "O corner:" (rtos angle_data 2 2)  "%%D"))<br />     (setq angle_data1 (strcat "I corner:" (rtos angle_data 2 2)  "%%D"))<br />     )<br />   <br /> ;  (if (> angle_data 180)<br /> ;      (progn<br /> ;        (setq angle_data (- angle_data 180))<br /> ;      (setq angle_data (- 180 angle_data))<br /> ;    )<br /> ;    (setq angle_data (atof (angtos (vla-get-measurement (vlax-ename->vla-object jd)))))<br /> ;    )<br /> ;    (command "text" "j" "mc" "0,0" "0" angle_data1 )<br /> ;  (command "erase" ent jd "")<br /> ;  (command "erase"  jd "")<br /> <br /> ;(setq f (open "c:\\temp\\angle.csv " "a"))<br /> (if (= f nil)<br />   (alert "C:\Temp\angle.csv 被其他程序打開,請關閉再試!!!")<br /> )<br /> <br /> ;(write-line (rtos angle_data 2 2) f)<br /> (setq list1 (append list1 (list angle_data)))<br /> (setq max_1 (apply 'max list1))<br /> (setq min_1 (apply 'min list1))<br /> (princ (strcat "\nMax Angle: " (rtos max_1) "°" "       Min Angle: " (rtos min_1) "°"))<br /> <br /> <br /> ;  (setq vla-ent (vlax-ename->vla-object ent))<br /> <br />   ;(command "ucs" "W")<br />   (setvar "osmode" oldos)<br />   (princ)<br />   )<br /> <br />   (defun prt (/ p1a p2a p3a p4a)<br />       (setq P1a "PT1" P2a "PT2" P3a "PT3" P4a "PT4" M4 "MPT12")<br />       (command<br />              "text" "j" "mc" (trans PT1 0 1) "0" p1a PT1<br />          "text" "j" "mc" (trans PT2 0 1) "0" p2a PT2<br />          "text" "j" "mc" (trans PT3 0 1) "0" p3a PT3<br />          "text" "j" "mc" (trans PT4 0 1) "0" p4a PT4<br />          "text" "j" "mc" (trans MPT12 0 1) "0" M4 MPT12<br />          ;(command "-MTEXT" PT1 "H" "10" "W" "0" P1a PT1 ""<br />           ;        "-MTEXT" PT2 "H" "10" "W" "0" P2a PT2 ""<br />         ;    "-MTEXT" PT3 "H" "10" "W" "0" P3a PT3 ""<br />         ;    "-MTEXT" PT4 "H" "10" "W" "0" P4a PT4 ""<br />         ;    "-MTEXT" MPT  "H" "10" "W" "0" M4 MPT ""<br />             )<br />             )

  

mingliang7709

zenem怎么没有执行命令啊

mingliang7709

麻烦给说下命令吧，谢谢