linear 发表于 2004-3-16 13:57:00

连接新轮廓线成实体的程序

(Defun c:bl (/ l ll)<BR>       (command "-boundary" "_a" "_o" "_r" "_i" "_y"        "_b" "_n" "" ""        zp "")<BR>       (command "-color" 9)<BR>       (command "hatch" "u" 0 0.1 "n" "l" "")<BR>       (command "explode" "l" "")


       (vl-load-com)<BR>       (setq ss (ssget "x" '((62 . 9))))<BR>       (setq i 0)<BR>       (setq pt_lst nil)<BR>       (repeat (sslength ss)<BR>                       (setq ent (ssname ss i))<BR>                       (setq ens (vlax-Ename-&gt;Vla-Object ent))<BR>                       (setq l (vlax-curve-getdistatparam<BR>                                               ens<BR>                                               (vlax-curve-getendparam ens)<BR>                               )<BR>                       )


                       (setq ll (+ (EXPT l 1.2) 0.1))<BR>                       (setq dx (/ (- ll l) 2))


                       (setq le (entget ent))<BR>                       (setq pt1x (car (cdr (assoc 10 le))))<BR>                       (setq pt1y (cadr (cdr (assoc 10 le))))<BR>                       (setq pt1z (caddr (cdr (assoc 10 le))))<BR>                       (setq pt1 (list (- pt1x dx) pt1y pt1z))


                       (setq le (entget ent))<BR>                       (setq pt2x (car (cdr (assoc 11 le))))<BR>                       (setq pt2y (cadr (cdr (assoc 11 le))))<BR>                       (setq pt2z (caddr (cdr (assoc 11 le))))<BR>                       (setq pt2 (list (+ pt2x dx) pt2y pt2z))


                       (setq pt_lst (append pt_lst (list (list pt1 pt2))))


                       (entdel ent)<BR>                       (setq i (1+ i))<BR>       )<BR>       (command "-color" 7)<BR>       (command "spline")<BR>       (mapcar '(lambda (e) (command (car e))) pt_lst)<BR>       (mapcar '(lambda (e) (command (cadr e))) (reverse pt_lst))<BR>       (command "c" "")<BR>       (command "move" "l" "" zp "@10,-5")


       (princ)


)


<BR>(defun c:sl ()<BR>       (vl-load-com)<BR>       (setq ent (car (entsel "pick up the object")))<BR>       (setq entv (vlax-ename-&gt;vla-object ent))<BR>       (vla-getboundingbox entv 'pt1 'pt2)<BR>       (setq        h (abs (- (last (vlax-safearray-&gt;list pt1))<BR>                       (last (vlax-safearray-&gt;list pt2))<BR>                                                       )<BR>               )<BR>       )<BR>       (setq z (last (vlax-safearray-&gt;list pt2)))


       (setq sl (/ h 10))<BR>       (setq sec (ssadd))<BR>       (setq i 0)


       (repeat 11<BR>                       (setq dh (+ z (* i sl)))<BR>                       (setq zp (list 0 0 dh))<BR>                       (command "section" ent "" "xy" "" zp)<BR>                       (command "bl")<BR>                       (setq sec (ssadd (entlast) sec))<BR>                                                       (setq i (1+ i))<BR>       )<BR>       <BR>       (command "surftab1" 500 "")


       (setq i 0)<BR>       (repeat 10<BR>                       (setq f (entget (ssname sec 0)))<BR>                       (setq g (entget (ssname sec 1)))<BR>                       (command "rulesurf" f g )<BR>                       (setq i (1+ i))<BR>       )<BR>       (princ)<BR>)


bl子程序是实现对每一层截面的轮廓进行放大后,得到新的轮廓的过程。


sl主程序用来获取圆柱体的很多截面,引用bl子程序,再连接相邻的两条新轮廓线成面,从而得到整个新的曲面。



请教:


1:在sl主程序里如何引用它上面bl程序?


2: (setq f (entget (ssname sec 0)))<BR>                       (setq g (entget (ssname sec 1)))


                       为什么f,g只显示一个物体的信息,而不是集合里的很多物体呢,


3:entget是选择了命令“rulesurf"需要选择的物体吗?


4:请问如何将面转化为体?


谢谢!

龙龙仔 发表于 2004-3-17 08:14:00

<P class=MsoNormal style="MARGIN: 0cm 0cm 0pt"><FONT size=3>把程序執行<FONT face="Times New Roman"> </FONT>前<FONT face="Times New Roman"> &amp; </FONT>後<FONT face="Times New Roman"> </FONT>貼上好嗎<FONT face="Times New Roman">?<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" /><o:p></o:p></FONT></FONT>

linear 发表于 2004-3-17 13:38:00

先执行主程序SL


defun c:sl ()<BR>       (vl-load-com)<BR>       (setq ent (car (entsel "pick up the object")))<BR>       (setq entv (vlax-ename-&gt;vla-object ent))<BR>       (vla-getboundingbox entv 'pt1 'pt2)<BR>       (setq        h (abs (- (last (vlax-safearray-&gt;list pt1));获取圆柱体的高<BR>                       (last (vlax-safearray-&gt;list pt2))<BR>                                                       )<BR>               )<BR>       )<BR>       (setq z (last (vlax-safearray-&gt;list pt2)));获取底圆的中心z坐标


       (setq sl (/ h 10));将高分为10等份<BR>       (setq sec (ssadd));<BR>       (setq i 0)


       (repeat 11<BR>                       (setq dh (+ z (* i sl)))                                                                                                                               ;获取每个截圆的z坐标<BR>                       (setq zp (list 0 0 dh))                                                                                                                               ;获取每个截圆的中心坐标zp<BR>                       (command "section" ent "" "xy" "" zp)                                                                                       :将上面的坐标zp用在获取截圆上<BR>                       (command "bl")        ;对它执行上面的子程序bl,这步改为(setq ee (bl zp)),好像还是不对<BR>                       (setq sec (ssadd (entlast) sec))                        ;将得到的新各个截面的轮廓线收入一个集合中<BR>                                                       (setq i (1+ i))<BR>       )<BR>       <BR>       (command "surftab1" 500 "")                                                                                                                                       ;改变系统变量surftab1成500


       (setq i 0)<BR>       (repeat 10<BR>                       (setq f (entget (ssname sec 0)))                                ;从上面得到的集合中取出第一个截面新轮廓<BR>                       (setq g (entget (ssname sec 1)))               ;从上面得到的集合中取出下一个截面新轮廓<BR>                       (command "rulesurf" f g )                                                                                                               ;将它们联成一曲面<BR>                       (setq i (1+ i))<BR>       )<BR>       (princ)<BR>)


       


这是执行时 command history.里显示的内容:


Command: SL<BR>pick up the objectsection<BR>Select objects:               1 found<BR>Select objects: Specify first point on Section plane by <BR> &lt;3points&gt;: xy Specify a point on the <BR>XY-plane &lt;0,0,0&gt;:<BR>Command:<BR>Command: ; error: bad function: (0 0 5.70287)


提示错误在(setq ee (bl zp)),这一步的zp.


非常感谢!

龙龙仔 发表于 2004-3-17 17:11:00

我要看執行前後的效果圖!

linear 发表于 2004-3-18 01:10:00




这是执行前的图,执行后应该是表明凹凸不平的圆柱体。


谢谢!

linear 发表于 2004-3-18 03:11:00

下面是对一个圆柱体进行取一个截面圆的过程,请问为什么它执行时总是对(0,0,0)而非zp(0,0,1) 呢?


(defun e ()<BR>                                               (setq zp '(0 0 1))<BR>       (setq ent (entsel "pick up object"))<BR>                       (command "section" ent "" "xy" "" zp)<BR>       (princ)<BR>       )


已将上面插入bl子程序改为(bl zp), bl 程序首改为(defun bl (zp / l ll),结果出来很多个截面,但都是在一个面上的,不知道是不是坐标系的问题?谢谢!@10,-5 相对位置,是不是z不变?

龙龙仔 发表于 2004-3-18 07:56:00

看不出你要甚麼?








linear 发表于 2004-3-18 17:17:00

龙龙仔,真的太谢谢你了。谢谢你的热心和无私。你们在这个板块上,花精力为大家解答,而且不取分文报酬。我脑海里想到的是伟大二字,真的。谢谢!


上面的程序给了我很多的启示。


1:sl主程序中的z 是最高点的z坐标,所以下面应该用(setq j (1- j))


2:副程序bl里去掉取boundary一行,因为zp很可能是不在截面上的一点。


3:加入 (setq eee (entlast))


4:move 命令中修改为(command "move" "l" "" "-250,0,0" ZP)


这几步都是程序成败的关键。自己想破脑壳也想不到哪里错的地方。


还有几小问:


1:在bl程序尾部的(command "erase" ss "")是什么作用?


2:如何让生成的几段曲面联成为一个整体


3:如何让面变为体,可以填充吗?


谢谢!!!<BR>

linear 发表于 2004-3-18 17:19:00




图刚才忘了上传

龙龙仔 发表于 2004-3-19 08:48:00

<P class=MsoNormal style="MARGIN: 0cm 0cm 0pt; WORD-BREAK: break-all; LINE-HEIGHT: 12pt; mso-margin-top-alt: auto; mso-margin-bottom-alt: auto; mso-pagination: widow-orphan">1:在bl程式尾部的(command "erase" ss "")是什麼作用?<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" /><o:p></o:p>


<P class=MsoNormal style="MARGIN: 0cm 0cm 0pt 13.5pt; WORD-BREAK: break-all; TEXT-INDENT: -13.5pt; LINE-HEIGHT: 12pt; mso-margin-top-alt: auto; mso-margin-bottom-alt: auto; mso-pagination: widow-orphan; mso-char-indent-count: -1.5"><SPAN style="mso-spacerun: yes">       -&gt;        (command        "explode"        (entlast))</SPAN><BR>                (setq        SS        (ssget        "p"));;選取explode後之物件<o:p></o:p>


<P class=MsoNormal style="MARGIN: 0cm 0cm 0pt 13.5pt; WORD-BREAK: break-all; TEXT-INDENT: -13.5pt; LINE-HEIGHT: 12pt; mso-margin-top-alt: auto; mso-margin-bottom-alt: auto; mso-pagination: widow-orphan; mso-char-indent-count: -1.5">2:如何讓生成的幾段曲面聯成為一個整體<o:p></o:p>


<P class=MsoNormal style="MARGIN: 0cm 0cm 0pt 13.5pt; WORD-BREAK: break-all; TEXT-INDENT: -13.5pt; LINE-HEIGHT: 12pt; mso-margin-top-alt: auto; mso-margin-bottom-alt: auto; mso-pagination: widow-orphan; mso-char-indent-count: -1.5"><SPAN style="mso-spacerun: yes">       -&gt;AUTOCAD</SPAN>沒有辦法(SOLIDEGDE試試)


<P class=MsoNormal style="MARGIN: 0cm 0cm 0pt; WORD-BREAK: break-all; LINE-HEIGHT: 12pt; mso-margin-top-alt: auto; mso-margin-bottom-alt: auto; mso-pagination: widow-orphan">3:如何讓面變為體,可以填充嗎? <o:p></o:p>


<P class=MsoNormal style="MARGIN: 0cm 0cm 0pt; WORD-BREAK: break-all; LINE-HEIGHT: 12pt; mso-margin-top-alt: auto; mso-margin-bottom-alt: auto; mso-pagination: widow-orphan"><SPAN style="mso-spacerun: yes">       -&gt;AUTOCAD</SPAN>沒有辦法(SOLIDEGDE試試)<o:p></o:p>
页: [1] 2
查看完整版本: 连接新轮廓线成实体的程序