LISP. Быстрая отрисовка 3D трубопроводов (экструдирование) (Страница 1 из 3)

(defun c:xtube(/ 3DPOS ACTDOC ACTLAY ACTSP BASELINE
           BASESET DICOUNT DIVDID EXCIR EXENT
           EXTUBE INCIR INENT INTUBE LAYST
           OBJTYPE OLDECHO OLDEXDIA OLDINDIA
           STARTPT XORD YORD ZORD *ERROR*)
  (vl-load-com)
  (defun *error* (msg)
    (vla-put-Lock actLay laySt)
    (setvar "CMDECHO" oldEcho)
    (vla-EndUndoMark actDoc)
    (princ)
    ); end of *error*
  (if(not tube:exDia)(setq tube:exDia 40.0))
  (if(not tube:inDia)(setq tube:inDia 37.0))
  (setq actDoc
    (vla-get-ActiveDocument
      (vlax-get-Acad-object))
    actLay(vla-get-ActiveLayer actDoc)
        oldexDia tube:exDia
    oldinDia tube:inDia
        oldEcho(getvar "CMDECHO")
   ); end setq
  (vla-StartUndoMark actDoc)
  (setvar "CMDECHO" 0)
  (if(= 0(vla-get-ActiveSpace actDoc))
    (setq actSp(vla-get-PaperSpace actDoc))
    (setq actSp(vla-get-ModelSpace actDoc))
    ); end if
  (setq laySt(vla-get-Lock actLay))
  (vla-put-Lock actLay :vlax-false)
  (setq tube:exDia
    (getreal
      (strcat
        "\nSpecify external diameter <"(rtos tube:exDia)">: "))
       tube:inDia
    (getreal
      (strcat
        "\nSpecify internal diameter <"(rtos tube:inDia)">: "))
    ); end setq
  (if(null tube:inDia)(setq tube:inDia oldinDia))
  (if(null tube:exDia)(setq tube:exDia oldexDia))
  (if(< tube:inDia tube:exDia)
    (progn
  (princ "\n<<< Select objects to extrude and press Enter >>>")
  (if
    (setq baseSet
      (ssget '((-4 . "<OR")(0 . "*LINE")(0 . "CIRCLE")
           (0 . "ARC")(0 . "ELLIPSE")(-4 . "OR>")
           (-4 . "<NOT")(-4 . "<OR")(0 . "SPLINE")
                (0 . "MLINE")(-4 . "OR>")(-4 . "NOT>"))))
    (progn
      (setq baseSet(vl-remove-if 'listp
                              (mapcar
                'cadr
                (ssnamex baseSet))))
      (foreach pathEnt baseSet
      (setq baseLine
        (vlax-ename->vla-object pathEnt)
       objType(vla-get-ObjectName baseLine)
            startPt(vlax-curve-getStartPoint baseLine)
            3dPos
        (vlax-curve-getFirstDeriv baseLine
          (vlax-curve-getParamAtPoint baseLine startPt))
           diCount(strlen
            (itoa
         (apply 'max
          (mapcar 'abs
           (mapcar 'fix startPt)))))
       divDid "1"
       ); end setq
      (repeat diCount
   (setq divDid(strcat divDid "0"))
   ); end repeat
      (setq divDid(atoi divDid))
      (if(/= 0.0(car 3dPos))
   (setq XOrd(/(car 3dPos)divDid))
   (setq XOrd (car 3dPos))
   ); end if
      (if(/= 0.0(cadr 3dPos))
   (setq YOrd(/(cadr 3dPos)divDid))
   (setq YOrd (cadr 3dPos))
   ); end if
      (if(/= 0.0(nth 2 3dPos))
   (setq ZOrd(/(nth 2 3dPos)divDid))
   (setq ZOrd (nth 2 3dPos))
   ); end if
      (setq 3dPos(list XOrd YOrd ZOrd))
  (setq exCir
     (vla-addCircle actSp
       (vlax-3d-Point startPt)
       (/ tube:exDia 2))
    inCir
     (vla-addCircle actSp
       (vlax-3d-Point startPt)
       (/ tube:inDia 2))
    ); end setq
  (vla-put-Normal exCir(vlax-3D-point 3dPos))
  (vla-put-Normal inCir(vlax-3D-point 3dPos))
  (setq exEnt(vlax-vla-object->ename exCir)
    inEnt(vlax-vla-object->ename inCir)
    ) ; end setq
  (command "_.extrude" exEnt "" "_p" pathEnt)
  (setq exTube(entlast))
  (command "_.extrude" inEnt "" "_p" pathEnt)
  (setq inTube(entlast))
  (command "_subtract" exTube "" inTube "")
  (command "_.erase" exEnt "")
  (command "_.erase" inEnt "")
  (vla-delete baseLine)
   ); end foreach
      (vla-put-Lock actLay laySt)
      (setvar "CMDECHO" oldEcho)
       ); end progn
      ); end if
     ); end progn
    (princ "\nInternal diameter more or equal than external diameter! ")
    ); end if
  (vla-EndUndoMark actDoc)
    (princ)
    ); end  of c:xtube

^C^C(if (not C:XTUBE) (load "xtube")) XTUBE