- (defun trans2dda (ename / AcadObject AcadDocument mSpace ent_data str_0 obj pts sngSArea)
- (VL-LOAD-COM)
-
- (setq AcadObject (vlax-get-acad-object))
- (setq AcadDocument (vla-get-ActiveDocument Acadobject))
- (setq mSpace (vla-get-ModelSpace Acaddocument))
-
- ;(setq ename (car (entsel "选择要转换的三维多段线:")))
- (setq ent_data (entget ename))
- (setq str_0 (cdr (assoc 0 ent_data)))
- (while (/= str_0 "POLYLINE")
- (setq ename (car (entsel "选择的实体非三维多段线,请重新选择!:")))
- (setq ent_data (entget ename))
- (setq str_0 (cdr (assoc 0 ent_data)))
- )
- (setq obj (vlax-ename->vla-object ename))
- (setq pts (vlax-variant-value (vla-get-coordinates obj)))
-
- ;(vlax-ename->vla-object (vla-AddPolyline mSpace pts) )
- ;(setq vlaSTrigon (vlax-ename->vla-object objSTrigon));将转化成VLA 对象
- (setq sngSArea (vlax-curve-getArea (vla-AddPolyline mSpace pts) ))
- (entdel (entlast))
- ;(princ)
- sngSArea
- )
- (defun xyp-CurveLength (s1) (vlax-curve-getDistAtParam s1 (vlax-curve-getEndParam s1)))
- ;;;;;;;;;;;;;;;;;;;;;;;;;
- (defun c:xzfgw ( / ss fgmj ee i sss fgzc) ;飞时达异常方格删除
- (setq fgmj (getreal "\n请输入方格面积5位小数如25.00000:") )
- (setq fgzc (getreal "\n请输入方格周长5位小数如20.00000:") )
- ;(setq fgmj (trans2dda (car (entsel "\n请选择样板方格:"))) )
-
- (setq ss (ssget '( (0 . "polyline") (8 . "tf-fg1") ))
- i 0
- )
- (setq sss (ssadd))
- (while (setq ee (ssname ss i))
-
- (if (or (> (-(xyp-CurveLength ee) 0.001) fgzc) (> (- (trans2dda ee) 0.001) fgmj) )
- (progn (ssadd ee sss) )
- )
-
- (setq i (1+ i))
- )
- (sssetfirst nil sss)
-
-
- )
|