线模到实体的研究

blackhawks

小弟是新手，我知道已经有很多前辈做过直接由线性模型生成实体模型的程序，不过没有看到过源代码。所以自己编了一个，发上来大家指点。还有一个问题没有解决，就是做管子相贯，没有思路，希望大家给个思路。

(defun c:ltog ()

  (vl-load-com)
  (setq acadobject   (vlax-get-acad-object)
 acaddocument (vla-get-activedocument acadobject)
 mspace      (vla-get-modelspace acaddocument)
  )
  (command "ucs" "")
  (setq ss1 (ssget '((0 . "*LINE,ARC"))))
  (setq n (sslength ss1))
  (setq D (getreal "Input D:")
 ti (getreal "Input t: ")
 radius (/ D 2)
 )
  (setq i 0)
  (while (< i n)
    (set (read (strcat "ssobj" (rtos i)))
  (vlax-ename->vla-object (ssname ss1 i))
    )
    (setq pnt1 (vlax-curve-getstartpoint
   (eval (read (strcat "ssobj" (rtos i))))
        )
    )
    (setq point1 (vlax-make-safearray vlax-vbdouble '(0 . 2)))
    (vlax-safearray-fill
      point1
      (list (nth 0 pnt1) (nth 1 pnt1) (nth 2 pnt1))
    )

    (setq pnt2 (vlax-curve-getendpoint
   (eval (read (strcat "ssobj" (rtos i))))
        )
    )
    
    (command "ucs" "_zaxis" pnt1 pnt2)
    (setq circleobject1 (vla-addcircle mspace point1 radius))
    (setq circleobject2 (vla-addcircle mspace point1 (- radius ti)))
    (setq curves (vlax-make-safearray vlax-vbobject '(0 . 1)))
    (vlax-safearray-fill
      curves
      (list circleobject1 circleobject2)
    )
    (setq rgionobject (vla-addregion mspace curves))
    (vla-boolean
      (vlax-safearray-get-element
 (vlax-variant-value rgionobject)
 1
      )
      acsubtraction
      (vlax-safearray-get-element
 (vlax-variant-value rgionobject)
 0
      )
    )
    (setq rgionename
    (vlax-vla-object->ename
      (vlax-safearray-get-element
        (vlax-variant-value rgionobject)
        1
      )
    )
    )
    (command "extrude"
      rgionename
      ""
      "p"
      (ssname ss1 i)
    )
    (vla-regen acaddocument :vlax-true)
    (command "ucs" "p" "")

    (setq i (1+ i))
  )
)
(princ "这是一个直接将所选中线变成管子的程序，运行程序ltog")
(prin1)

如果要其它截面的，原理是一样的，你也可以通过定义图层来自动生成。

不过，我还没有加入圆\椭圆线，希望大家补充。

blackhawks

没人感兴趣啊，我先自己顶一下

blackhawks

求教如何编制程序绘制相贯管子？