给ACAD增加个MAP里面的MPSplit（拆分多重多边形）命令

Lispboy · 发表于 2017-3-1 11:20:36

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有帐号？立即注册

x

(defun c:XDTB_MPSplit (/ #PatternColor #PatternDouble #PatternName
#PatternScale #PatternSpace #PatternType e ints
poly pts s tf x
)
(defun _draw ()
(xdrx_initget "U")
(if (setq pts (xd::doc:getfence "\n第一点" "\n下一点" 1))
(setq poly (xdrx_polyline_make pts))
)
poly
)
(defun _split (e poly)
(xdrx_getpropertyvalue e "PatternName" "PatternSpace" "PatternDouble"
"PatternType" "PatternScale" "PatternColor"
)
(if (xdrx_mpolygon_split e poly)
(progn
(mapcar
'(lambda (x)
(xdrx_setpropertyvalue x "PatternSpace" #PatternSpace
"PatternDouble" #PatternDouble
"PatternScale" #PatternScale
"PatternColor" #PatternColor "Pattern"
(list #PatternType #PatternName)
)
)
(list e (entlast))
)
)
)
)
(xdrx_begin)
(if (setq e (car (setq e (xdrx_entsel "\n选取拆分的多重多边形<退出>:"))))
(progn
(setq tf t)
(xdrx_pickset_redraw e)
(while (and
tf
(xdrx_initget "D")
(progn
(setq s (xdrx_entsel "\n选取裁剪边界[绘制(D)]<绘制>:" '
((0 . "LINE,*POLYLINE,ARC,ELLIPSE,CIRCLE,SPLINE"))
)
)
t
)
)
(progn
(if (not s)
(setq s "D")
)
(cond
((= s "D")
(setq s (_draw))
)
((= (type s) 'LIST)
(setq s (car s))
)
)
(if s
(progn
(setq ints (xdrx_entity_intersectwith s e))
(if (= (length ints) 2)
(progn
(setq tf nil)
(_split e s)
(xdrx_prompt "\n拆分成功.")
)
(progn
(xdrx_prompt "\n无法以选取的边界拆分多重多边形，重试..")
)
)
(if poly
(xdrx_entity_delete poly)
)
)
)
)
)
)
)
(xdrx_end)
(princ)
)

(defun c:XDTB_MPSplit (/ #PatternColor #PatternDouble #PatternName 
                         #PatternScale #PatternSpace #PatternType e ints 
                         poly pts s tf x 
                      ) 
  (defun _draw () 
    (xdrx_initget "U") 
    (if (setq pts (xd::doc:getfence "\n第一点" "\n下一点" 1)) 
      (setq poly (xdrx_polyline_make pts)) 
    ) 
    poly 
  ) 
  (defun _split (e poly) 
    (xdrx_getpropertyvalue e "PatternName" "PatternSpace" "PatternDouble" 
                           "PatternType" "PatternScale" "PatternColor" 
    ) 
    (if (xdrx_mpolygon_split e poly) 
      (progn 
        (mapcar 
          '(lambda (x) 
             (xdrx_setpropertyvalue x "PatternSpace" #PatternSpace 
                                    "PatternDouble" #PatternDouble 
                                    "PatternScale" #PatternScale 
                                    "PatternColor" #PatternColor "Pattern" 
                                    (list #PatternType #PatternName) 
             ) 
           ) 
          (list e (entlast)) 
        ) 
      ) 
    ) 
  ) 
  (xdrx_begin) 
  (if (setq e (car (setq e (xdrx_entsel "\n选取拆分的多重多边形<退出>:")))) 
    (progn 
      (setq tf t) 
      (xdrx_pickset_redraw e) 
      (while (and 
               tf 
               (xdrx_initget "D") 
               (progn 
                 (setq s (xdrx_entsel "\n选取裁剪边界[绘制(D)]<绘制>:" ' 
                                      ((0 . "LINE,*POLYLINE,ARC,ELLIPSE,CIRCLE,SPLINE")) 
                         ) 
                 ) 
                 t 
               ) 
             ) 
        (progn 
          (if (not s) 
            (setq s "D") 
          ) 
          (cond 
            ((= s "D") 
              (setq s (_draw)) 
            ) 
            ((= (type s) 'LIST) 
              (setq s (car s)) 
            ) 
          ) 
          (if s 
            (progn 
              (setq ints (xdrx_entity_intersectwith s e)) 
              (if (= (length ints) 2) 
                (progn 
                  (setq tf nil) 
                  (_split e s) 
                  (xdrx_prompt "\n拆分成功.") 
                ) 
                (progn 
                  (xdrx_prompt "\n无法以选取的边界拆分多重多边形，重试..") 
                ) 
              ) 
              (if poly 
                (xdrx_entity_delete poly) 
              ) 
            ) 
          ) 
        ) 
      ) 
    ) 
  ) 
  (xdrx_end) 
  (princ) 
)

里皎相 · 发表于 2017-3-1 16:45:10

好东西，收藏学习了。

zou_ys888 · 发表于 2017-8-8 09:33:22

好东西，谢谢分享了

pur2 · 发表于 2018-7-31 19:02:02

这个可以用，非常好用。

帐号		自动登录	找回密码
密码			立即注册

[曲线] 给ACAD增加个MAP里面的MPSplit（拆分多重多边形）命令

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。