本帖最后由 夏生生 于 2021-12-13 23:10 编辑
代码又臭又长
- ;;;思路是建立两个断面,断面中心连线,
- ;;;后续可以根据连线再求出连线的垂面,利用垂面建立断面,可以求得直径和壁厚
- (defun c:test (/ value2list vxv ANG DOC LST1 LST2 OBJ OBJ1 OBJ2 OBJ3 PT1 PT1A PT2 PT2A PT3 PT3A SS)
- (defun value2list (value)
- (setq value (vl-catch-all-apply
- (function vlax-safearray->list)
- (list (vlax-variant-value value))
- )
- )
- (if (= (type value) (function LIST))
- value
- nil
- )
- )
- (defun vxv (u v)
- (list
- (- (* (cadr u) (caddr v)) (* (cadr v) (caddr u)))
- (- (* (car v) (caddr u)) (* (car u) (caddr v)))
- (- (* (car u) (cadr v)) (* (car v) (cadr u)))
- )
- )
- (setq pt1 (getpoint "\n栏选起点:")
- pt2 (getpoint pt1 "\n栏选终点:")
- pt3 (mapcar '+ pt1 '(0 0 1))
- ang (+ (* 0.5 pi) (angle pt1 pt2))
- pt1a (polar pt1 ang 1)
- pt2a (polar pt2 ang 1)
- pt3a (mapcar '+ pt1a '(0 0 1))
- ss (ssget "f" (list pt1 pt2) '((0 . "3DSOLID")))
- obj (vlax-ename->vla-object (ssname ss 0))
- pt1 (vlax-3d-point pt1)
- pt1a (vlax-3d-point pt1a)
- pt2 (vlax-3d-point pt2)
- pt2a (vlax-3d-point pt2a)
- pt3 (vlax-3d-point pt3)
- pt3a (vlax-3d-point pt3a)
- doc (vlax-get-property (vlax-get-acad-object) 'activedocument)
- doc (if (= 1 (getvar "cvport"))
- (vlax-get-property doc 'paperspace)
- (vlax-get-property doc 'modelspace)
- )
- obj1 (vla-SectionSolid obj pt1 pt2 pt3)
- obj2 (vla-SectionSolid obj pt1a pt2a pt3a)
- lst1 (value2list (vla-explode obj1))
- lst2 (value2list (vla-explode obj2))
- pt1 (vla-get-Center (car lst1))
- pt2 (vla-get-Center (car lst2))
- obj3 (vla-addline doc pt1 pt2)
- )
- (vla-ScaleEntity obj3 pt1 1000)
- (foreach n (append (list obj1 obj2) lst1 lst2)
- (vla-delete n)
- )
- (setq pt1 (value2list pt1)
- pt2 (value2list pt2)
- pt3 (mapcar '- pt2 pt1) ;_法向量
- pt1a (distance '(0 0 0) pt3) ;_法向量的模
- pt1a (mapcar '(lambda (x) (/ x pt1a)) pt3) ;_单位向量
- pt2a (vl-list* (- (cadr pt1a)) (car pt1a) (cddr pt1a)) ;_pt1a旋转90度
- pt3a (vxv pt1a pt2a) ;_垂面点1
- pt2a (vxv pt1a pt3a) ;_垂面点2
- obj1 (vla-SectionSolid
- obj
- (vlax-3d-point pt1)
- (vlax-3d-point (mapcar '+ pt1 pt3a))
- (vlax-3d-point (mapcar '+ pt1 pt2a))
- )
- lst1 (value2list (vla-explode obj1))
- lst2 (vl-sort (mapcar 'vla-get-Diameter lst1) '>)
- )
- (vla-delete obj1)
- (princ (strcat "\n直径:"
- (rtos (car lst2) 2 2)
- ";壁厚:"
- (rtos (* 0.5 (- (car lst2) (cadr lst2))) 2 2)
- )
- )
- (princ)
- )
|