矩形框批量wipeout
(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)
)
问题在什么地方，请各路大神指出来，为什么还要选择封闭多线段，为什么批量不了
真是汗啊，(command "_.wipeout" (p1,p2) (p1+20.8333,p2) (p1+20.8333,p2-12.5) (p1,p2-12.5) "" "" "N"))这一句问题太多了。程序不是你写得吧，怎么会有这么奇葩的写法？ zyhandw 发表于 2013-12-12 09:09 static/image/common/back.gif
真是汗啊，(command "_.wipeout" (p1,p2) (p1+20.8333,p2) (p1+20.8333,p2-12.5) (p1,p2-12.5) "" "" "N")) ...
哈哈，怎么改啊 (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 objblkdef
(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)
) 实在看不懂你这是要做什么，是要以多段线的起点做个矩形遮盖吗？改了下，不一定能达到你的要求，你下载试试！最好能把你的要求详细说明下，并附上测试的dwg。 zyhandw 发表于 2013-12-12 09:37 static/image/common/back.gif
实在看不懂你这是要做什么，是要以多段线的起点做个矩形遮盖吗？改了下，不一定能达到你的要求，你下载试试 ...
感谢 学习，谢谢！！！！！！！1 为什么会出现这样的效果，实在看不明白，计算没有问题啊
页:
[1]