生成相交线的外轮廓和闭合图元

guosheyang

    借用三维命令将多个相交线生成外轮廓和封闭图元，，2017CAD测试通过  ，建议高版本测试，有问题请反馈。
;借用三维命令将多个相交线生成外轮廓和封闭图元（样条线 多段线 直线 圆 椭圆 圆弧 椭圆弧均适用）
;参数：ss 需要生成外轮廓和封闭图元的相交曲线选择集         
;注意：spl线不能自相交，对封闭嵌套曲线生成的嵌套面域未做处理
;(ygs_outline_bo(ssget))
(defun ygs_outline_bo(ss / JX PT SJD SS1 SZ UN_SURF YSD YXD ZSD ZXD ZXYS)
  (setvar 'cmdecho 0)
  (setvar 'delobj 3)
  (setq zxys(LM:ssboundingbox ss)
        zxd(list(-(car (car zxys))100)(-(cadr (car zxys))100)0)
        ysd(list(+(car (cadr zxys))100)(+(cadr (cadr zxys))100)0)
        zsd(list(car zxd)(cadr ysd)0)
        yxd(list(car ysd)(cadr zxd)0)
        sjd(list zxd yxd ysd zsd));四角点
(setq ss1(ssget "WP" sjd '((0 . "LWPOLYLINE,POLYLINE"))))
(vl-cmdf "qaflags" 1 ".explode" ss1 """qaflags" 0);炸开多段线
(setq ss(ssget "WP" sjd )
       sz(getvar 'surfacemodelingmode))
(if(= sz 1)
    (command "_.extrude""MO""SU" ss "" 2 """"
            "_.union" (ssget "A" '((0 . "NURBSURFACE"))) "")
    (command "_.extrude""MO""SU" ss "" 2 """"
           "_.union" (ssget "A" '((0 . "EXTRUDEDSURFACE"))) "")
)
(setq un_surf(entlast))
(entmakex(append (list '(0 . "LWPOLYLINE")
                          '(100 . "AcDbEntity")
                          '(100 . "AcDbPolyline")
                          '(62 . 0)
                          (cons 90 (length sjd))
                          (cons 70 1)
                   )
                   (mapcar '(lambda (pt) (cons 10 pt)) sjd)
         )
)
(command "_.REGION"
         (setq jx(entlast))
        ""
        "_.intersect"
           (entlast)
           un_surf
        ""
   "_.erase" ss ""
)
; (entdel jx)
  (setq ss(ssget "WP" sjd ))
  (command "region" ss ""
           "_vscurrent" "C")
  (princ)
)
;选择集包围盒 -Lee Mac
(defun LM:ssboundingbox(sel / idxllp ls1 ls2 obj urp)
    (repeat (setq idx(sslength sel))
        (setq obj (vlax-ename->vla-object(ssname sel(setq idx (1- idx)))))
        (if (and (vlax-method-applicable-p obj 'getboundingbox)
                 (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'llp 'urp))))
            )
            (setq ls1 (cons (vlax-safearray->list llp) ls1)
                  ls2 (cons (vlax-safearray->list urp) ls2)
            )
        )
    )
    (if (and ls1 ls2)
        (mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list ls1 ls2))
    )
)

999999

谢谢大神分享，厉害厉害

戏男

历害了，谢谢

ARSummer.d

谢谢大神分享，厉害厉害

LYC688

用不了，——，———

guosheyang

LYC688 发表于 2022-9-1 02:01
用不了，——，———

你的CAD版本是多少？低了不行的