矩形框批量wipeout

偏爱云~小吴 · 发表于 2013-12-12 08:59:56

(defun c:Jx ()
(setvar "CMDECHO" 0)
(if (setq ss (ssget '((0 . "LWPOLYLINE")))) (progn
(setq i -1)
(repeat (sslength ss)
(setq ent (entget (ssname ss (setq i (1+ i))))
p1 (cddr(assoc 10 ent))
p2 (caDdr(assoc 10 ent)))
(command "_.wipeout" (p1,p2) (p1+20.8333,p2) (p1+20.8333,p2-12.5) (p1,p2-12.5) "" "" "N")
)
(command "_.ERASE" ss "")
))
(setvar "CMDECHO" 1)
(princ)
)
问题在什么地方，请各路大神指出来，为什么还要选择封闭多线段，为什么批量不了

zyhandw · 发表于 2013-12-12 09:09:43

真是汗啊，(command "_.wipeout" (p1,p2) (p1+20.8333,p2) (p1+20.8333,p2-12.5) (p1,p2-12.5) "" "" "N"))这一句问题太多了。程序不是你写得吧，怎么会有这么奇葩的写法？

偏爱云~小吴 · 发表于 2013-12-12 09:13:18

zyhandw 发表于 2013-12-12 09:09
真是汗啊，(command "_.wipeout" (p1,p2) (p1+20.8333,p2) (p1+20.8333,p2-12.5) (p1,p2-12.5) "" "" "N")) ...

哈哈，怎么改啊

偏爱云~小吴 · 发表于 2013-12-12 09:36:51

(defun wipeout2plst (wo / elst u v mat)
(setq elst (entget wo)
u (cdr (assoc 11 elst))
v (cdr (assoc 12 elst))
mat (list u (mapcar '- v) '(0. 0. 1.))
)
(mapcar
'(lambda (p)
(mapcar '+
(mxv (trp mat) p)
(mapcar '(lambda (x y) (/ (+ x y) 2.)) u v)
(cdr (assoc 10 elst))
)
)
(cdr
(mapcar 'cdr
(vl-remove-if-not '(lambda (x) (= (car x) 14)) elst)
)
)
)
)
;; Transpose a matrix Doug Wilson
(defun trp (m)
(apply 'mapcar (cons 'list m))
)
(mapcar 'list '(1 2 3) '(4 5 6) '(7 8 9 10))
;; Apply a transformation matrix to a vector by Vladimir Nesterovsky
(defun mxv (m v)
(mapcar '(lambda (r) (apply '+ (mapcar '* r v))) m)
)
(defun delblkwipe (blkname / blkdef objname)
(setq blkdef
(vla-item (vla-get-blocks
(vla-get-ActiveDocument (vlax-get-acad-object)))
blkname))
(if (/= :vlax-true (vla-get-IsXRef blkdef))
(vlax-for obj blkdef
(cond
((= "AcDbWipeout" (setq objname (vla-get-ObjectName obj)))
(setq pl (wipeout2plst (vlax-vla-object->ename obj))
pl (apply 'append (mapcar '(lambda (X) (list (car x) (cadr x)) ) pl))
)
(setq o
(vla-AddLightWeightPolyline blkdef (vlax-safearray-fill
(vlax-make-safearray
vlax-vbDouble
(cons 0 (1- (length pl)))
)
pl
)
)
)
(vla-put-closed o :vlax-true)
(vla-put-layer o (vla-get-layer obj))
(vla-delete obj)
)
((or (= "AcDbMInsertBlock" objname)
(= "AcDbBlockReference" objname)
)
(delblkwipe (vla-get-name obj))
)
)
)
)
)
;;
(defun c:111(/ e)
(while (and (setq e (car(entsel)))
(= "INSERT" (cdr (assoc 0 (entget e))))
)
(delblkwipe (cdr (assoc 2 (entget e))))
(command "_.regen")
)
(princ)
)

(defun wipeout2plst (wo / elst u v mat) 
  (setq         elst (entget wo) 
         u    (cdr (assoc 11 elst)) 
         v    (cdr (assoc 12 elst)) 
         mat  (list u (mapcar '- v) '(0. 0. 1.)) 
  ) 
  (mapcar 
    '(lambda (p) 
       (mapcar '+ 
                (mxv (trp mat) p) 
                (mapcar '(lambda (x y) (/ (+ x y) 2.)) u v) 
                (cdr (assoc 10 elst)) 
       ) 
     ) 
    (cdr 
      (mapcar 'cdr 
               (vl-remove-if-not '(lambda (x) (= (car x) 14)) elst) 
      ) 
    ) 
  ) 
) 
 
;; Transpose a matrix Doug Wilson 
(defun trp (m) 
  (apply 'mapcar (cons 'list m)) 
) 
(mapcar 'list '(1 2 3) '(4 5 6)  '(7 8 9 10)) 
 
;; Apply a transformation matrix to a vector by Vladimir Nesterovsky 
(defun mxv (m v) 
  (mapcar '(lambda (r) (apply '+ (mapcar '* r v))) m) 
) 
(defun delblkwipe  (blkname / blkdef objname) 
 
  (setq        blkdef 
 
         (vla-item (vla-get-blocks 
 
                     (vla-get-ActiveDocument (vlax-get-acad-object))) 
 
                   blkname)) 
 
  (if (/= :vlax-true (vla-get-IsXRef blkdef)) 
 
    (vlax-for obj  blkdef 
 
      (cond 
 
        ((= "AcDbWipeout" (setq objname (vla-get-ObjectName obj))) 
         (setq pl (wipeout2plst (vlax-vla-object->ename obj)) 
               pl (apply 'append (mapcar '(lambda (X) (list (car x) (cadr x)) ) pl)) 
               ) 
         (setq o 
                (vla-AddLightWeightPolyline blkdef (vlax-safearray-fill 
                                              (vlax-make-safearray 
                                                vlax-vbDouble 
                                                (cons 0 (1- (length pl))) 
                                              ) 
                                              pl 
                                            ) 
           ) 
               ) 
         (vla-put-closed o :vlax-true) 
         (vla-put-layer o (vla-get-layer obj)) 
         (vla-delete obj) 
 
         ) 
 
        ((or (= "AcDbMInsertBlock" objname) 
 
             (= "AcDbBlockReference" objname) 
 
             ) 
 
         (delblkwipe (vla-get-name obj)) 
 
         ) 
 
        ) 
 
      ) 
 
    ) 
 
  ) 
 
;; 
 
(defun c:111(/ e) 
 
  (while (and (setq e (car(entsel))) 
 
              (=  "INSERT" (cdr (assoc 0 (entget e)))) 
 
              ) 
 
    (delblkwipe (cdr (assoc 2 (entget e)))) 
 
    (command "_.regen") 
 
    ) 
 
  (princ) 
 
  )

zyhandw · 发表于 2013-12-12 09:37:22

实在看不懂你这是要做什么，是要以多段线的起点做个矩形遮盖吗？改了下，不一定能达到你的要求，你下载试试！最好能把你的要求详细说明下，并附上测试的dwg。

偏爱云~小吴 · 发表于 2013-12-12 09:49:56

zyhandw 发表于 2013-12-12 09:37
实在看不懂你这是要做什么，是要以多段线的起点做个矩形遮盖吗？改了下，不一定能达到你的要求，你下载试试 ...

感谢

mycad · 发表于 2013-12-13 13:30:26

学习，谢谢！！！！！！！1

偏爱云~小吴 · 发表于 2013-12-14 12:58:34

为什么会出现这样的效果，实在看不明白，计算没有问题啊

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

[提问] 矩形框批量wipeout

本帖子中包含更多资源

本帖子中包含更多资源

本帖子中包含更多资源