请版主老顾修改一个程序
 

请版主老顾修改一个程序
www.dimcax.com
请版主老顾修改一个程序
我下载了一个沿三维线段拉伸圆的 lisp 小程序，可在autocad2004中使用，能否修改成可拉伸任何形状实体？类似于auotcad2008中的扫略命令，有劳版主，谢谢。附源程序
(defun c:3dc ()
;(command "ucs" "o")
;(xload "ame")
(setq $$ss (ssget))
(setq radd (* 0.5 (getdist "\n请输入管子直径: ")))
(setq mmm 0)
(while (< mmm (sslength $$ss) )
(setq $ent (ssname $$ss mmm))
(if (= (dxf 0 (entget $ent)) "line")
(uline $ent radd)
(if (= (dxf 0 (entget $ent)) "arc")
(uarc $ent radd)
)
)
(setq mmm (+ 1 mmm))
)
)
(defun uline (uent rrr / )
(command "ucs" "w")
(command "ucs" "za" (dxf 10 (entget uent)) (dxf 11 (entget uent)) )
(command "circle" (list 0.0 0.0 0.0) rrr)
(setq $circ (entlast))
(command "ucs" "w")
(command "extrude" $circ "" (distance (dxf 10 (entget uent)) (dxf 11 (entget uent)) ) 0.0)
)
(defun uarc ($uent rrr / )
(command "ucs" "w")
(command "ucs" "e" $uent)
(command "ucs" "x" 90)
(setq ggg (dxf 40 (entget $uent)))
(command "circle" (list ggg 0.0 0.0) rrr)
(setq $circ (entlast))
(setq $ang2 (dxf 51 (entget $uent)))
(setq $ang1 (dxf 50 (entget $uent)))
(if (> $ang1 $ang2)(setq $ang2 (+ (* 2.0 pi) $ang2)))
(if (> $ang1 $ang2)(setq $z -1)(setq $z 1))
(setq $ang (* (/ 180.0 pi) (- $ang2 $ang1) ) )
(command "revolve" $circ "" (list 0 0 0)(list 0 $z 0) $ang)
(command "ucs" "w")
)
(defun dxf (code elist)
(cdr (assoc code elist))
);
(prompt "\n执行 3d 命令运行程序")

图片：

;我下载了一个沿三维线段拉伸圆的 lisp 小程序，可在autocad2004中使用，能否修改成可拉伸任何形状实体？
;类似于auotcad2008中的扫略命令，有劳版主，谢谢。附源程序
我改了一下,见下:
(defun c:3dc ()
(setq ss (ssget))
(setq radd (* 0.5 (getdist "\n请输入管子直径: ")))
(setq mmm 0)
(while (< mmm (sslength ss) )
(setq ent (ssname ss mmm) en (entget ent) bb (cdr (assoc 0 en)))
(if (= bb "line")
(progn
(setq p1 (cdr (assoc 10 en)) p2 (cdr (assoc 11 en)) )
(command "circle" p1 radd)
(setq ee (ssget "l"))
(command "rotate3d" ee ""p1 p2 "90" "rotate" ee ""p1 "90" )
(command "extrude" ee "" "p" ent)
)
(if (= bb "arc")
(progn
(setq p1 (cdr (assoc 10 en)) r (cdr (assoc 40 en)) an (cdr (assoc 50 en)) p2 (polar p1 an r) ang1 (* (- (* pi 0.5) an) (/ 180 pi)))
(command "circle" p2 radd)
(setq ee (ssget "l"))
(command "rotate3d" ee ""p1 p2 "90" "rotate" ee ""p1 ang1 )
(command "extrude" ee "" "p" ent)

)
(if (= bb "lwpolyline")
(progn
(setq p1 (nth 14 en) p1 (list (cadr p1) (caddr p1)) p2 (nth 18 en) p2 (list (cadr p2) (caddr p2)) )
(command "circle" p1 radd)
(setq ee (ssget "l"))
(command "rotate3d" ee ""p1 p2 "90" "rotate" ee ""p1 90 )
(command "extrude" ee "" "p" ent)
)
)))
(setq mmm (+ 1 mmm))
)
)