lisp 、cad 高手,100分求答案.
我用LISP编了一个对孔进行填充的程序,如果是在CAD中画的孔,命令P9后正常填充。如果孔是由UG导进来的则有时会出现了填充不上的问题,求答案。;;;;;;;;;;;;;...
我用LISP编了一个对孔进行填充的程序,如果是在CAD中画的孔,命令P9后正常填充。如果孔是由UG导进来的则有时会出现了填充不上的问题,求答案。
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;
(defun c:P9 (/ v1 v2 sl1 px p0 x0 y0 e1 elist1 r0 x1 p1 x2 p2 y3 p3 y4 p4 r0i d0 jl1 jl2
x5 p5 x6 p6 y7 p7 y8 p8 e2 e3 e4 e5 e6 e7 d0i d0s tt1 tl )
(setvar "cmdecho" 0)
(setvar "blipmode" 0)
(setq v1 (getvar "osmode"))
(setvar "osmode" 0)
(setq v2 (getvar "clayer"))
(setq sl1 (entsel "\n请选择孔!"))
(setq px (cadr sl1 ))
(setq p0 (osnap px "center"));;;;;
(setq x0 (car p0 ))
(setq y0 (cadr p0))
(setq e1 (car sl1 ))
(setq elist1 (entget e1 ))
(setq r0 (cdr (assoc 40 elist1 )));;;;;
(setq x1 (- x0 r0))
(setq p1 (list x1 y0))
(setq x2 (+ x0 r0))
(setq p2 (list x2 y0))
(setq y3 (+ y0 r0))
(setq p3 (list x0 y3))
(setq y4 (- y0 r0))
(setq p4 (list x0 y4))
(setq r0i (fix r0))
(setq d0 (* r0 2))
(setq jl1 (/ d0 10.0))
(setq jl2 (+ jl1 r0))
(setq x5 (- x0 jl2))
(setq p5 (list x5 y0))
(setq x6 (+ x0 jl2))
(setq p6 (list x6 y0))
(setq y7 (+ y0 jl2))
(setq p7 (list x0 y7))
(setq y8 (- y0 jl2))
(setq p8 (list x0 y8))
(If (Null (Tblsearch "ltype" "center2"));加载线型center2
(command "linetype" "load" "center2" "acad" ""))
(if (not (tblsearch "LAYER" "Cen"))
(command "layer" "m" "Cen" "c" 2 "" "l" "center2" "" "lw" 0.18 "" ""))
(if (null (tblsearch "style" "gb"));设置文字式样gb
(command "style" "gb" "gbenor,gbcbig" "" "1" "" "" ""))
(if (not (tblsearch "LAYER" "Text"));创建图层Text
(command "layer" "m" "Text" "c" 7 "" "l" "continuous" "" "lw" 0.18 "" ""))
(setvar "clayer" "Cen")
(command "line" p5 p6 "")
(command "line" p7 p8 "")
(command "line" p0 p3 "")
(setq e2 (entlast))
(command "line" p0 p2 "")
(setq e3 (entlast))
(command "arc" "c" p0 p2 p3 )
(setq e4 (entlast))
(command "line" p0 p4 "")
(setq e5 (entlast))
(command "line" p0 p1 "")
(setq e6 (entlast))
(command "arc" "c" p0 p1 p4 )
(setq e7 (entlast))
(command "hatch" "solid" e2 e3 e4 "")
(command "hatch" "solid" e5 e6 e7 "")
(command "ERASE" e2 e3 e4 e5 e6 e7"")
(setvar "clayer" "text")
(setvar "textstyle" "gb")
(setq d0i (fix d0))
(setq d0s (itoa d0i))
(setq tt1 (strcat "D" d0s))
(setq tl (/ r0 2.0) )
(command "text" "j" "r" P0 tl 0 tt1))
(setvar "osmode" v1)
(setvar "clayer" v2)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
我有CAD图例,随时发给你,要结合CAD图档的。就是上图的CAD图档,报下邮箱。不懂或半懂的不要回答,谢谢。 展开
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;
(defun c:P9 (/ v1 v2 sl1 px p0 x0 y0 e1 elist1 r0 x1 p1 x2 p2 y3 p3 y4 p4 r0i d0 jl1 jl2
x5 p5 x6 p6 y7 p7 y8 p8 e2 e3 e4 e5 e6 e7 d0i d0s tt1 tl )
(setvar "cmdecho" 0)
(setvar "blipmode" 0)
(setq v1 (getvar "osmode"))
(setvar "osmode" 0)
(setq v2 (getvar "clayer"))
(setq sl1 (entsel "\n请选择孔!"))
(setq px (cadr sl1 ))
(setq p0 (osnap px "center"));;;;;
(setq x0 (car p0 ))
(setq y0 (cadr p0))
(setq e1 (car sl1 ))
(setq elist1 (entget e1 ))
(setq r0 (cdr (assoc 40 elist1 )));;;;;
(setq x1 (- x0 r0))
(setq p1 (list x1 y0))
(setq x2 (+ x0 r0))
(setq p2 (list x2 y0))
(setq y3 (+ y0 r0))
(setq p3 (list x0 y3))
(setq y4 (- y0 r0))
(setq p4 (list x0 y4))
(setq r0i (fix r0))
(setq d0 (* r0 2))
(setq jl1 (/ d0 10.0))
(setq jl2 (+ jl1 r0))
(setq x5 (- x0 jl2))
(setq p5 (list x5 y0))
(setq x6 (+ x0 jl2))
(setq p6 (list x6 y0))
(setq y7 (+ y0 jl2))
(setq p7 (list x0 y7))
(setq y8 (- y0 jl2))
(setq p8 (list x0 y8))
(If (Null (Tblsearch "ltype" "center2"));加载线型center2
(command "linetype" "load" "center2" "acad" ""))
(if (not (tblsearch "LAYER" "Cen"))
(command "layer" "m" "Cen" "c" 2 "" "l" "center2" "" "lw" 0.18 "" ""))
(if (null (tblsearch "style" "gb"));设置文字式样gb
(command "style" "gb" "gbenor,gbcbig" "" "1" "" "" ""))
(if (not (tblsearch "LAYER" "Text"));创建图层Text
(command "layer" "m" "Text" "c" 7 "" "l" "continuous" "" "lw" 0.18 "" ""))
(setvar "clayer" "Cen")
(command "line" p5 p6 "")
(command "line" p7 p8 "")
(command "line" p0 p3 "")
(setq e2 (entlast))
(command "line" p0 p2 "")
(setq e3 (entlast))
(command "arc" "c" p0 p2 p3 )
(setq e4 (entlast))
(command "line" p0 p4 "")
(setq e5 (entlast))
(command "line" p0 p1 "")
(setq e6 (entlast))
(command "arc" "c" p0 p1 p4 )
(setq e7 (entlast))
(command "hatch" "solid" e2 e3 e4 "")
(command "hatch" "solid" e5 e6 e7 "")
(command "ERASE" e2 e3 e4 e5 e6 e7"")
(setvar "clayer" "text")
(setvar "textstyle" "gb")
(setq d0i (fix d0))
(setq d0s (itoa d0i))
(setq tt1 (strcat "D" d0s))
(setq tl (/ r0 2.0) )
(command "text" "j" "r" P0 tl 0 tt1))
(setvar "osmode" v1)
(setvar "clayer" v2)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
我有CAD图例,随时发给你,要结合CAD图档的。就是上图的CAD图档,报下邮箱。不懂或半懂的不要回答,谢谢。 展开
展开全部
1、你前面提取圆心的代码烦琐了点,直接提取组码10即得到圆心坐标了,采用图面捕捉容易造成程序执行结果不稳定。
2、建议在获得圆心和半径后直接采用entmake创建直线或填充对象,而不是使用command,这样的话只要获取你所选择的圆的圆心坐标和半径,就肯定能创建直线和填充图案,效率高、运行稳定且不依赖于捕捉模式,不需要绘制辅助线。
可否把用UG导入的不能正常填充的图形传一份过来?287329118@qq.com
2、建议在获得圆心和半径后直接采用entmake创建直线或填充对象,而不是使用command,这样的话只要获取你所选择的圆的圆心坐标和半径,就肯定能创建直线和填充图案,效率高、运行稳定且不依赖于捕捉模式,不需要绘制辅助线。
可否把用UG导入的不能正常填充的图形传一份过来?287329118@qq.com
追问
非常感谢,已发送请查看。
追答
对于你程序出现问题的原因,和采用entmake函数创建对象的简单例程,刚才已经发到你邮箱里了。顺便看了下你的程序,主要是因为原来的圆的Z坐标不为零,导致后面绘制的辅助线Z不在一个平面内,因此无法填充。将前面的p0的Z坐标去掉,即在(setq p0 (osnap px "center"))后面再加一句(setq p0 (list (car p0) (cadr p0)))或(setq p0 (list x0 y0))运行就正常了。
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询