Jump to content

Need A Lisp for 3d solid pipe length

danielk

By danielk
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

danielk Community Regular

danielk

Posted
Posted

Im looking for a lisp to sum the values of 3d pipe solids , each pipe own its own layer ,represent different diameter.

The info exist in the properties palette .( see picture attached -"Length")

 

Thanks !piping.jpg

marko_ribar Veteran

marko_ribar

Posted
Posted (edited)

It seems that this property isn't available through VLisp ActiveX...

 

Try this instead...

 

(defun c:sumsweeplengths ( / TMatrixFromTo ss i sum ent dir1 dir2 dir3 pm zdir tmat ll ur len )

 (vl-load-com)
 
 (defun TMatrixFromTo ( from to )
   (append
     (mapcar
       (function
         (lambda    (v o)
           (append (trans v from to T) (list o))
         )
       )
       (list '(1. 0. 0.) '(0. 1. 0.) '(0. 0. 1.))
       (trans '(0. 0. 0.) to from)
     )
     (list '(0. 0. 0. 1.))
   )
 )

 (command "_.ucs" "_w")
 (prompt "\nSelect 3D SOLIDS created with SWEEP command")
 (setq ss (ssget '((0 . "3DSOLID"))))
 (setq i -1 sum 0.0)
 (while (setq ent (ssname ss (setq i (1+ i))))
   (if ent (setq ent (vlax-ename->vla-object ent)))
   (if (vlax-property-available-p ent 'SolidType)
     (if (eq (vla-get-SolidType ent) "Sweep")
       (progn
         (setq dir1 (mapcar '+ (vlax-safearray->list (vlax-variant-value (vla-get-principaldirections ent))) '(0.0 0.0 0.0)))
         (setq dir2 (cdddr (mapcar '+ (vlax-safearray->list (vlax-variant-value (vla-get-principaldirections ent))) '(0.0 0.0 0.0 0.0 0.0 0.0))))
         (setq dir3 (cdddr (cdddr (mapcar '+ (vlax-safearray->list (vlax-variant-value (vla-get-principaldirections ent))) '(0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0)))))
         (setq pm (vlax-safearray->list (vlax-variant-value (vla-get-principalmoments ent))))
         (cond 
           ( (equal (cadr pm) (caddr pm) 1.0) 
             (setq zdir dir1)
           )
           ( (equal (car pm) (caddr pm) 1.0)
             (setq zdir dir2)
           )
           ( (equal (car pm) (cadr pm) 1.0) 
             (setq zdir dir3)
           )
         )
         (command "_.ucs" "_za" '(0.0 0.0 0.0) zdir)
         (setq tmat (TMatrixFromTo 1 0))
         (vla-transformby ent (vlax-tmatrix tmat))
         (vla-getboundingbox ent 'll 'ur)
         (setq ll (vlax-safearray->list ll))
         (setq ur (vlax-safearray->list ur))
         (cond 
           ( (and (> (caddr ur) 0) (> (caddr ll) 0) (> (caddr ur) (caddr ll)))
             (setq len (abs (- (caddr ur) (caddr ll))))
           )
           ( (and (> (caddr ur) 0) (> (caddr ll) 0) (< (caddr ur) (caddr ll)))
             (setq len (abs (- (caddr ll) (caddr ur))))
           )
           ( (and (< (caddr ur) 0) (< (caddr ll) 0) (< (caddr ur) (caddr ll)))
             (setq len (abs (- (caddr ur) (caddr ll))))
           )
           ( (and (< (caddr ur) 0) (< (caddr ll) 0) (> (caddr ur) (caddr ll)))
             (setq len (abs (- (caddr ll) (caddr ur))))
           )
           ( (and (< (caddr ur) 0) (> (caddr ll) 0))
             (setq len (abs (- (caddr ll) (caddr ur))))
           )
           ( (and (> (caddr ur) 0) (< (caddr ll) 0))
             (setq len (abs (- (caddr ur) (caddr ll))))
           )
         )
         (setq tmat (TMatrixFromTo 0 1))
         (vla-transformby ent (vlax-tmatrix tmat))
         (command "_.ucs" "_p")
       )
     )
   )
   (setq sum (+ len sum))
 )
 (prompt "\nSum of all lengths of 3D SOLIDS created with SWEEP command is : ")(princ (rtos sum 2 20))
 (princ)
)

(defun c:ssl nil (c:sumsweeplengths))

HTH, M.R.

Edited by marko_ribar
code changed
danielk Community Regular

danielk

Posted
  • Author
Posted
It seems that this property isn't available through VLisp ActiveX...

 

Try this instead...

 

(defun c:sumsweeplengths ( / TMatrixFromTo ss i sum ent zdir tmat ll ur len )

 (vl-load-com)
 
 (defun TMatrixFromTo ( from to )
   (append
     (mapcar
       (function
         (lambda    (v o)
           (append (trans v from to T) (list o))
         )
       )
       (list '(1. 0. 0.) '(0. 1. 0.) '(0. 0. 1.))
       (trans '(0. 0. 0.) to from)
     )
     (list '(0. 0. 0. 1.))
   )
 )

 (command "_.ucs" "_w")
 (prompt "\nSelect 3D SOLIDS created with SWEEP command")
 (setq ss (ssget '((0 . "3DSOLID"))))
 (setq i -1 sum 0.0)
 (while (setq ent (ssname ss (setq i (1+ i))))
   (if ent (setq ent (vlax-ename->vla-object ent)))
   (if (vlax-property-available-p ent 'SolidType)
     (if (eq (vla-get-SolidType ent) "Sweep")
       (progn
         (setq zdir (mapcar '+ (vlax-safearray->list (vlax-variant-value (vla-get-principaldirections ent))) '(0.0 0.0 0.0)))
         (command "_.ucs" "_za" '(0.0 0.0 0.0) zdir)
         (setq tmat (TMatrixFromTo 1 0))
         (vla-transformby ent (vlax-tmatrix tmat))
         (vla-getboundingbox ent 'll 'ur)
         (setq ll (vlax-safearray->list ll))
         (setq ur (vlax-safearray->list ur))
         (setq len (abs (- (caddr ur) (caddr ll))))
         (setq tmat (TMatrixFromTo 0 1))
         (vla-transformby ent (vlax-tmatrix tmat))
         (command "_.ucs" "_p")
       )
     )
   )
   (setq sum (+ len sum))
 )
 (prompt "\nSum of all lengths of 3D SOLIDS created with SWEEP command is : ")(princ (rtos sum 2 20))
 (princ)
)

(defun c:ssl nil (c:sumsweeplengths))

HTH, M.R.

Dont know why but the sum values are incorrect , to sweep pipe im using this lisp

(defun c:xpipe(/ ACTDOC ACTLAY ACTSP BASELINE 
         BASESET CIRENT DICOUNT DIVDID 
         EXCIR LAYST OBJTYPE OLDDIA 
         OLDECHO 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 pipe:exDia)(setq pipe:exDia 40.0)) 
 (setq actDoc 
   (vla-get-ActiveDocument 
     (vlax-get-Acad-object)) 
  actLay(vla-get-ActiveLayer actDoc) 
       oldDia pipe:exDia 
       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 pipe:exDia 
   (getreal 
     (strcat 
       "\nSpecify pipe diameter <"(rtos pipe:exDia)">: "))) 
 (if(null pipe:exDia)(setq pipe:exDia oldDia))
 (initget "Yes No") 
  (setq delFlag 
         (getkword "\nDelete extrude path(s)? [Yes/No] <No>: ")) 
   (if(null delFlag)(setq delFlag "No")) 
 (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) 
     (/ pipe:exDia 2))) 
 (vla-put-Normal exCir(vlax-3D-point 3dPos)) 
 (setq cirEnt(vlax-vla-object->ename exCir)) 
 (command "_.extrude" cirEnt "" "_p" pathEnt) 
 (command "_.erase" cirEnt "")
(if(= "Yes" delFlag) 
   (vla-delete baseLine) 
      ); end if 
  ); end foreach 
     (vla-put-Lock actLay laySt) 
     (setvar "CMDECHO" oldEcho) 
     (vla-EndUndoMark actDoc) 
      ); end progn 
     ); end if 
   (princ) 
   ); end  of c:xpipe

marko_ribar Veteran

marko_ribar

Posted
Posted

Warning note... If you plan to use my code seriously, be sure shape that was swept is significantly smaller than "linear" path... Path must be linear - I've tested this only on cylinders and straight prisms...

 

Regards, M.R.

danielk Community Regular

danielk

Posted
  • Author
Posted

is it possible to create a program that ignore all other objects unless they have in propeties under 'geometry' the "length" data?

marko_ribar Veteran

marko_ribar

Posted
Posted

I have to revive this thread... It isn't solved as should... If someone knows how to access Geometry properties of 3DSOLID entity, please reply... The problem are sweeps with curves as paths, and also if accessed Geometry properties that info could be useful for all other types of 3DSOLID entities...

 

Thanks, kind regards, Marko Ribar...

marko_ribar Veteran

marko_ribar

Posted
Posted

Reviving again... Please reply if you are smart...

 

M.R.

danielk Community Regular

danielk

Posted
  • Author
Posted
Reviving again... Please reply if you are smart...

 

M.R.

im also waiting if there's someone who can do it ... if this info exist in properties there's must be a way !

  • 3 months later...
pattyandme Contributor

pattyandme

Posted
Posted

you might need to create a list that creates a diminution line gets the length of each 3d object in a layer builds a list to populate a table of fields then destroys the dimension lines it created.

Its in the wish list for new development as from what I've seen in the forms it can not be extracted in data extraction in the 2013 version.

Kind of looking for the same thing to build a table from data extraction of the length of the blocks after they are exploded into 3d solids.

 

 

If it were a constant length then you could use a attribute within a block and get that data.

still looking

  • 9 months later...
Zac Davis Enthusiast

Zac Davis

Posted
Posted

Finally there is a solution, Check out this page Here theres also a video showing this lisp in action

danielk Community Regular

danielk

Posted
  • Author
Posted
Finally there is a solution, Check out this page Here theres also a video showing this lisp in action

Thanks , exactly what i was looking for!!!:):):D

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...