求助-求自动画两个面夹角及角平分线的lsp
本帖最后由 feizheng 于 2011-7-9 17:14 编辑各位大虾,我LSP还未入门,能看简单的,现在遇到一个东东,需要画两个三维面的夹角(图中红色线),并画角平分线(图中紫色线),
因为每次操作要好几个步骤(转UCS及画直线),而我有好多这样的面需要重复标的,所以求哪位能帮忙编个lsp,这样每次只需要选择四个点,相关的三条线就通过LSP来画。
先谢谢了。
本帖最后由 ljpnb 于 2011-7-10 07:41 编辑
一直以来只处理二维的问题,对三维了解很少,程序也未作优化,对点的处理一定有更简单的方法.程序基本能实现要求..... 谢谢ljpnb,辛苦你了。
功能基本能实现了,可以画两条垂直于面的交线的直线了,但好像角平分线没有画。
还有就是运行这个lsp之前好像要把坐标改为世界坐标,否则直线会跑掉。
呵呵,比我想象中的程序长。
feizheng 发表于 2011-7-10 00:52 static/image/common/back.gif
谢谢ljpnb,辛苦你了。
功能基本能实现了,可以画两条垂直于面的交线的直线了,但好像角平分线没有画。
修改过了,你再试试.... 本帖最后由 feizheng 于 2011-7-10 10:50 编辑
谢谢,功能完全实现了,可以画角平分线了。试了一下,旋转坐标后也线不会跑了。
继续探讨,因组成两个面的不一定是直线,可能是多义线或多面网格,所以我之前的想法是利用直线上点来画:
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 于 2014-7-12 21:02 编辑
我给你发一个!最好能帮我改改代码也发给我一份!我之前也一直找这个,但总找不到,但自己又是菜鸟,只有自己乱搞了一个!使用方法是:选择1、2、3、4就画出角度了!使用之前最好用 ST 命令设置一下文字样式,要不然运行出错! (代码里面有一些可能你用不到,你就直接删除掉吧! )
(defun midpoint (m1 m2)
(setq ptx (+ (nth 0 m1) (/ (- (nth 0 m2) (nth 0 m1)) 2 )))
(setq pty (+ (nth 1 m1) (/ (- (nth 1 m2) (nth 1 m1)) 2 )))
(setq ptz (+ (nth 2 m1) (/ (- (nth 2 m2) (nth 2 m1)) 2 )))
(list ptx pty ptz)
)
(defun wtu (pt)
(trans pt 0 1)
)
(defun utw (pt)
(trans pt 1 0)
)
(defun c:2mj (/ pt1 pt2 pt3 pt4 mpt mp1 mpt-a sp ep mp ang ang1 dang)
(command "ucs" "na" "d" "oucs"
"ucs" "na" "s" "oucs"
"ucs" "w")
(setq oldos (getvar "osmode"))
(setvar "osmode" 1025)
(setq pt1 (getpoint "\nPlease select AXIS point1:")
pt2 (getpoint "\nPlease select AXIS point2:")
pt3 (getpoint "\nPlease select point3:")
pt4 (getpoint "\nPlease select point4:")
;mpt (midpoint pt1 pt2)
)
(setvar "osmode" 0)
(setq mpt (midpoint pt1 pt2) )
;(setq mpt (polar pt1 (angle pt1 pt2) (* 0.5 (distance pt1 pt2))))
(setq hfp (* 0.2 (distance pt1 mpt)))
(command "ucs" "3p"pt1 pt2 pt3 )
(setq L1 (strcat "@" (rtos hfp) "<-90"))
(setq Line_1 (ssadd))
(command "line" (wtu pt3) L1 "")
(ssadd (entlast) Line_1)
(setq ent1 (entget (ssname Line_1 0)))
(setq mp1 (trans (cdr (assoc 11 ent1)) 0 1))
(setq mpt-a (wtu mpt ))
(command "move" Line_1 "" mp1 mpt-a)
(command "ucs" "w"
"ucs" "3p" pt1 pt2 pt4
)
(setq Line_2 (ssadd))
(command "line" (wtu pt4 ) L1 "")
(ssadd (entlast) Line_2)
(setq ent2 (entget (ssname Line_2 0)))
(setq mp2 (wtu (cdr (assoc 11 ent2)) ))
(command "move" Line_2 "" mp2 mpt-a)
;(setvar "osmode" oldos)
(command "ucs" "ob" Line_1
"ucs" "x" "-90")
(command "Pedit" Line_2 "y" "j" Line_1 "" "x")
(command "ucs" "w" )
(setq ent (entlast))
(setq sp (wtu (vlax-curve-getStartPoint ent))
ep (wtu (vlax-curve-getEndPointent))
;mp mpt
dd1 (* 0.5 hfp)
)
;(command "line" sp ep "")
(command "ucs" "3p" sp ep mpt)
(setq di (* 0.5 (distance sp ep))
mdn (list di 0 0)
)
(command "ucs" "n" (setq mdn (list di 0 0)))
(command "line" "0,0" (wtu mpt) "")
(setq test_point (nth 1 (wtu mpt)))
(if (< test_point 0)
(setq fx "@0,50")
(setq fx "@0,-50")
)
;(setq nmd (polar sp (angle sp ep) (* 0.5 (distance sp ep))))
;(command "point" nmd)
;(command "line" mp nmd "")
(if (> (nth 1 (getvar "ucsydir" ) ) 0)
(command "ucs" "x" "180")
)
(command "DIMANGULAR" "" (wtu mpt) (wtu ep) (wtu sp)fx)
(setq jd (entlast))
(setq angle_data (atof (angtos (vla-get-measurement (vlax-ename->vla-object jd)))))
(if (> angle_data 180)
(setq angle_data1 (strcat "O corner:" (rtos angle_data 2 2)"%%D"))
(setq angle_data1 (strcat "I corner:" (rtos angle_data 2 2)"%%D"))
)
;(if (> angle_data 180)
; (progn
; (setq angle_data (- angle_data 180))
; (setq angle_data (- 180 angle_data))
; )
; (setq angle_data (atof (angtos (vla-get-measurement (vlax-ename->vla-object jd)))))
; )
; (command "text" "j" "mc" "0,0" "0" angle_data1 )
;(command "erase" ent jd "")
;(command "erase"jd "")
;(setq f (open "c:\\temp\\angle.csv " "a"))
(if (= f nil)
(alert "C:\Temp\angle.csv 被其他程序打開,請關閉再試!!!")
)
;(write-line (rtos angle_data 2 2) f)
(setq list1 (append list1 (list angle_data)))
(setq max_1 (apply 'max list1))
(setq min_1 (apply 'min list1))
(princ (strcat "\nMax Angle: " (rtos max_1) "°" " Min Angle: " (rtos min_1) "°"))
;(setq vla-ent (vlax-ename->vla-object ent))
;(command "ucs" "W")
(setvar "osmode" oldos)
(princ)
)
(defun prt (/ p1a p2a p3a p4a)
(setq P1a "PT1" P2a "PT2" P3a "PT3" P4a "PT4" M4 "MPT12")
(command
"text" "j" "mc" (trans PT1 0 1) "0" p1a PT1
"text" "j" "mc" (trans PT2 0 1) "0" p2a PT2
"text" "j" "mc" (trans PT3 0 1) "0" p3a PT3
"text" "j" "mc" (trans PT4 0 1) "0" p4a PT4
"text" "j" "mc" (trans MPT12 0 1) "0" M4 MPT12
;(command "-MTEXT" PT1 "H" "10" "W" "0" P1a PT1 ""
; "-MTEXT" PT2 "H" "10" "W" "0" P2a PT2 ""
; "-MTEXT" PT3 "H" "10" "W" "0" P3a PT3 ""
; "-MTEXT" PT4 "H" "10" "W" "0" P4a PT4 ""
; "-MTEXT" MPT"H" "10" "W" "0" M4 MPT ""
)
)
zenem怎么没有执行命令啊 麻烦给说下命令吧,谢谢
页:
[1]