填充选线或描点挖洞

Free-Lancer · 发表于 2014-2-26 10:02:34

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

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

×

本帖最后由 Free-Lancer 于 2014-2-26 10:05 编辑

仅支持"普通"模式填充
矩形挖洞http://bbs.xdcad.net/thread-671357-1-1.html

(defun c:tt (/ _drawpline _appendinnerloop ha key)
(defun _drawpline (/ p ptl len plobj)
(while (and (setq p (if ptl
(getpoint (car ptl) "\nPoint: ")
(getpoint "\nPoint: ")
)
)
(setq ptl (cons p ptl))
(progn
(if (> (setq len (length ptl)) 1)
(grdraw p (cadr ptl) -1 0)
)
t
)
)
)
(if (> len 3)
(progn
(setq
plobj (vlax-invoke
(fy:acspace)
'AddLightweightPolyline
(apply
'append
(mapcar '(lambda (x) (list (car x) (cadr x))) ptl)
)
)
)
(vla-put-closed plobj :vlax-true)
)
)
(redraw)
plobj
)
(defun _appendinnerloop (ha curves /)
(vla-appendinnerloop
ha
(list->variantarray curves vlax-vbobject)
)
(if (= (vla-get-AssociativeHatch ha) :vlax-false)
(mapcar 'vla-delete curves)
)
(vla-evaluate ha)
)
(fy:begin)
(if (and (progn
(princ "\nPick Hatch Object .....")
(setq ha (ssget ":S:L" '((0 . "hatch") (75 . 0))))
)
(progn
(initget 128 "1 2")
(setq key (getkword "\n[1 - Points/2 - Select]<1>: "))
(if (or (null key) (= key ""))
(setq key "1")
(setq key "2")
)
)
)
(if (= key "1")
(if (setq pl (_drawpline))
(_appendinnerloop (e2o (ssname ha 0)) (list pl))
)
(if
(and (progn
(princ "\nSelect closed pline,circle,spline,ellipse ..."
)
(ssget '((0 . "*line,circle,spline,ellipse")))
)
(setq el (vl-remove-if-not
'(lambda (x) (vlax-curve-isclosed x))
(fy:cset->objs)
)
)
)
(_appendinnerloop (e2o (ssname ha 0)) el)
)
)
)
(fy:end)
(princ)
)

(defun c:tt (/ _drawpline _appendinnerloop ha key) 
  (defun _drawpline (/ p ptl len plobj) 
    (while (and        (setq p        (if ptl 
                          (getpoint (car ptl) "\nPoint: ") 
                          (getpoint "\nPoint: ") 
                        ) 
                ) 
                (setq ptl (cons p ptl)) 
                (progn 
                  (if (> (setq len (length ptl)) 1) 
                    (grdraw p (cadr ptl) -1 0) 
                  ) 
                  t 
                ) 
           ) 
    ) 
    (if        (> len 3) 
      (progn 
        (setq 
          plobj        (vlax-invoke 
                  (fy:acspace) 
                  'AddLightweightPolyline 
                  (apply 
                    'append 
                    (mapcar '(lambda (x) (list (car x) (cadr x))) ptl) 
                  ) 
                ) 
        ) 
        (vla-put-closed plobj :vlax-true) 
      ) 
    ) 
    (redraw) 
    plobj 
  ) 
  (defun _appendinnerloop (ha curves /) 
    (vla-appendinnerloop 
      ha 
      (list->variantarray curves vlax-vbobject) 
    ) 
    (if        (= (vla-get-AssociativeHatch ha) :vlax-false) 
      (mapcar 'vla-delete curves) 
    ) 
    (vla-evaluate ha) 
  ) 
  (fy:begin) 
  (if (and (progn 
             (princ "\nPick Hatch Object .....") 
             (setq ha (ssget ":S:L" '((0 . "hatch") (75 . 0)))) 
           ) 
           (progn 
             (initget 128 "1 2") 
             (setq key (getkword "\n[1 - Points/2 - Select]<1>: ")) 
             (if (or (null key) (= key "")) 
               (setq key "1") 
               (setq key "2") 
             ) 
           ) 
      ) 
    (if        (= key "1") 
      (if (setq pl (_drawpline)) 
        (_appendinnerloop (e2o (ssname ha 0)) (list pl)) 
      ) 
      (if 
        (and (progn 
               (princ "\nSelect closed pline,circle,spline,ellipse ..." 
               ) 
               (ssget '((0 . "*line,circle,spline,ellipse"))) 
             ) 
             (setq el (vl-remove-if-not 
                        '(lambda (x) (vlax-curve-isclosed x)) 
                        (fy:cset->objs) 
                      ) 
             ) 
        ) 
         (_appendinnerloop (e2o (ssname ha 0)) el) 
      ) 
    ) 
  ) 
  (fy:end) 
  (princ) 
)

XDnpu349 · 发表于 2014-3-9 16:26:03

漂亮！用的着啊:)

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

[教学] 填充选线或描点挖洞

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

评分