三维实体管道需要Lisp
我正在寻找一个lisp来汇总三维管道实体的值，每个管道都有自己的层，代表不同的直径。该信息存在于“特性”选项板中。（见所附图片-“长度”）
谢谢 此属性似乎无法通过VLisp ActiveX使用。。。
试试这个。。。
(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。 不知道为什么，但总和值不正确，使用此lisp扫描管道im
(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)? <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)
); endof c:xpipe 警告注释。。。若你们打算认真使用我的代码，请确保扫描的形状明显小于“线性”路径。。。路径必须是线性的-我只在圆柱和直棱镜上测试过。。。
您好，M.R。 是否可以创建一个忽略所有其他对象的程序，除非它们在“几何体”下具有“长度”数据的属性？ 我不知道，我试过了，但没有成功。。。我已经更改了我的初始代码，应该可以正确工作，但只适用于线性扫描。。。
此处更改：
http://www.cadtutor.net/forum/showthread.php?88563-Need-A-Lisp-for-3d-solid-pipe-length&p=607317#post607317
M、 R。 我必须恢复这条线。。。它没有得到应有的解决。。。如果有人知道如何访问3DSOLID实体的几何特性，请回复。。。问题是以曲线作为路径的扫描，如果访问几何体属性，则该信息可能对所有其他类型的3DSOLID实体有用。。。
谢谢，你好，马尔科·里巴。。。 再次复活。。。如果你很聪明，请回复。。。
M、 R。 我也在等待，如果有人能做到这一点。。。如果这些信息存在于属性中，那么一定有办法！ @丹尼尔克
可以附着DWG文件的副本吗？
页:
[1]
2