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

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

(Defun c:bl (/ l ll)
   (command "-boundary" "_a" "_o" "_r" "_i" "_y" "_b" "_n" "" "" zp "")
   (command "-color" 9)
   (command "hatch" "u" 0 0.1 "n" "l" "")
   (command "explode" "l" "")
   (vl-load-com)
   (setq ss (ssget "x" '((62 . 9))))
   (setq i 0)
   (setq pt_lst nil)
   (repeat (sslength ss)
   (setq ent (ssname ss i))
   (setq ens (vlax-Ename->Vla-Object ent))
   (setq l (vlax-curve-getdistatparam
   ens
   (vlax-curve-getendparam ens)
   )
   )
   (setq ll (+ (EXPT l 1.2) 0.1))
   (setq dx (/ (- ll l) 2))
   (setq le (entget ent))
   (setq pt1x (car (cdr (assoc 10 le))))
   (setq pt1y (cadr (cdr (assoc 10 le))))
   (setq pt1z (caddr (cdr (assoc 10 le))))
   (setq pt1 (list (- pt1x dx) pt1y pt1z))
   (setq le (entget ent))
   (setq pt2x (car (cdr (assoc 11 le))))
   (setq pt2y (cadr (cdr (assoc 11 le))))
   (setq pt2z (caddr (cdr (assoc 11 le))))
   (setq pt2 (list (+ pt2x dx) pt2y pt2z))
   (setq pt_lst (append pt_lst (list (list pt1 pt2))))
   (entdel ent)
   (setq i (1+ i))
   )
   (command "-color" 7)
   (command "spline")
   (mapcar '(lambda (e) (command (car e))) pt_lst)
   (mapcar '(lambda (e) (command (cadr e))) (reverse pt_lst))
   (command "c" "")
   (command "move" "l" "" zp "@10,-5")
   (princ)
)
(defun c:sl ()
   (vl-load-com)
   (setq ent (car (entsel "pick up the object")))
   (setq entv (vlax-ename->vla-object ent))
   (vla-getboundingbox entv 'pt1 'pt2)
   (setq h (abs (- (last (vlax-safearray->list pt1))
   (last (vlax-safearray->list pt2))
   )
   )
   )
   (setq z (last (vlax-safearray->list pt2)))
   (setq sl (/ h 10))
   (setq sec (ssadd))
   (setq i 0)
   (repeat 11
   (setq dh (+ z (* i sl)))
   (setq zp (list 0 0 dh))
   (command "section" ent "" "xy" "" zp)
   (command "bl")
   (setq sec (ssadd (entlast) sec))
   (setq i (1+ i))
   )

   (command "surftab1" 500 "")
   (setq i 0)
   (repeat 10
   (setq f (entget (ssname sec 0)))
   (setq g (entget (ssname sec 1)))
   (command "rulesurf" f g )
   (setq i (1+ i))
   )
   (princ)
)
bl子程序是实现对每一层截面的轮廓进行放大后，得到新的轮廓的过程。
sl主程序用来获取圆柱体的很多截面，引用bl子程序，再连接相邻的两条新轮廓线成面，从而得到整个新的曲面。请教：
1：在sl主程序里如何引用它上面bl程序？
2： (setq f (entget (ssname sec 0)))
   (setq g (entget (ssname sec 1)))
   为什么f,g只显示一个物体的信息，而不是集合里的很多物体呢,
3：entget是选择了命令“rulesurf"需要选择的物体吗？
4：请问如何将面转化为体？
谢谢！

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

把程序執行前 & 後貼上好嗎?

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

先执行主程序SL
defun c:sl ()
   (vl-load-com)
   (setq ent (car (entsel "pick up the object")))
   (setq entv (vlax-ename->vla-object ent))
   (vla-getboundingbox entv 'pt1 'pt2)
   (setq h (abs (- (last (vlax-safearray->list pt1))；获取圆柱体的高
   (last (vlax-safearray->list pt2))
   )
   )
   )
   (setq z (last (vlax-safearray->list pt2)))；获取底圆的中心z坐标
   (setq sl (/ h 10))；将高分为10等份
   (setq sec (ssadd))；
   (setq i 0)
   (repeat 11
   (setq dh (+ z (* i sl)))    ；获取每个截圆的z坐标
   (setq zp (list 0 0 dh))    ；获取每个截圆的中心坐标zp
   (command "section" ent "" "xy" "" zp)    ：将上面的坐标zp用在获取截圆上
   (command "bl") ;对它执行上面的子程序bl,这步改为(setq ee (bl zp)),好像还是不对
   (setq sec (ssadd (entlast) sec)) ；将得到的新各个截面的轮廓线收入一个集合中
   (setq i (1+ i))
   )

   (command "surftab1" 500 "")    ；改变系统变量surftab1成500
   (setq i 0)
   (repeat 10
   (setq f (entget (ssname sec 0))) ；从上面得到的集合中取出第一个截面新轮廓
   (setq g (entget (ssname sec 1)))    ；从上面得到的集合中取出下一个截面新轮廓
   (command "rulesurf" f g )    ；将它们联成一曲面
   (setq i (1+ i))
   )
   (princ)
)

这是执行时 command history.里显示的内容：
Command: SL
pick up the objectsection
Select objects:    1 found
Select objects: Specify first point on Section plane by
[Object/Zaxis/View/XY/YZ/ZX/3points] : xy Specify a point on the
XY-plane :
Command:
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

irznhzwmkl4.jpg

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

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

下面是对一个圆柱体进行取一个截面圆的过程，请问为什么它执行时总是对(0，0，0)而非zp(0,0,1) 呢？
(defun e ()
   (setq zp '(0 0 1))
   (setq ent (entsel "pick up object"))
   (command "section" ent "" "xy" "" zp)
   (princ)
   )
已将上面插入bl子程序改为(bl zp), bl 程序首改为(defun bl (zp / l ll),结果出来很多个截面，但都是在一个面上的，不知道是不是坐标系的问题？谢谢！@10,-5 相对位置，是不是z不变？

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

看不出你要甚麼?

pl3qq4bbhfa.jpg

请点击此处下载

请先注册会员后在进行下载

已注册会员，请先登录后下载

文件名称:l2c5022dyu5.LSP
下载次数:0 文件大小:2.41 KB 售价:2银币 [记录]
下载权限: 不限以上或 Vip会员 [开通Vip] [签到领银币] [免费赚银币]

请点击此处下载

请先注册会员后在进行下载

已注册会员，请先登录后下载

文件名称:31yawz0tytu.LSP
下载次数:0 文件大小:2.37 KB 售价:2银币 [记录]
下载权限: 不限以上或 Vip会员 [开通Vip] [签到领银币] [免费赚银币]

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

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：如何让面变为体，可以填充吗？
谢谢！！！

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

gnkowtkjlfa.jpg

图刚才忘了上传

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

1：在bl程式尾部的(command "erase" ss "")是什麼作用？
   -> (command "explode" (entlast))
(setq SS (ssget "p"));;選取explode後之物件
2：如何讓生成的幾段曲面聯成為一個整體
   ->AUTOCAD沒有辦法(SOLIDEGDE試試)
3：如何讓面變為體，可以填充嗎？
   ->AUTOCAD沒有辦法(SOLIDEGDE試試)

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

发表回复

精选推荐

浏览过的版块