首先选择所有矩形或垂直线，
假设所有这些对象都位于
在层“0”上
然后选择水平线
仅在A2008eng上测试
Hth公司
;;hm.lsp
(defun group-by-num (lst num / ls ret)
(if (= (rem (length lst) num ) 0)
(progn
(setq ls nil)
(repeat (/ (length lst) num)
(repeat num (setq ls
(cons (car lst) ls)
lst (cdr lst)))
(setq ret (append ret (list (reverse ls)))
ls nil)))
)
ret
)
;;holes markers
(defun C:hm (/ acsp adoc axss bpt cnt en ipt obj oline points ss wid)
(or adoc
(setq adoc
(vla-get-activedocument
(vlax-get-acad-object)
)
)
)
(or acsp
(setq acsp
(vla-get-block
(vla-get-activelayout adoc)
)
)
)
(setq wid 6.5515)
(if (and (setq ss (ssget '((0 . "LWPOLYLINE,LINE")(8 . "0"))));;select objects on layer "0"
(setq en (entsel "\nSelect Intersecting Line > ")))
(progn
(setq axss (vla-get-activeselectionset adoc)
oline (vlax-ename->vla-object (car en))
)
(vlax-for obj axss
(if (not (vl-catch-all-error-p
(setq ipt (vl-catch-all-apply
(function (lambda()
(vlax-invoke obj 'IntersectWith oline acextendnone))))))
)
(if (= (length ipt) 3)
(setq points (append (list ipt) points))
(setq points (append (group-by-num ipt 3) points))
)))
(setq points (vl-sort points (function (lambda(a b)(< (car a)(car b))))))
(setq cnt 1)
(while (setq ipt (car points))
(if (= (rem cnt 2) 1)
(setq ipt (list (- (car ipt) wid)(cadr ipt)(caddr ipt)))
)
(setq bpt (cons ipt bpt))
(setq points (cdr points))
(setq cnt (1+ cnt))
)
(while (setq ipt (car bpt))
(vlax-invoke acsp 'InsertBlock ipt "3ANSYMB" 1 1 1 0)
(setq bpt (cdr bpt))
)
)
)
(princ)
)
(vl-load-com)
~'J'~ 啊，对-我不太清楚为什么它在07或08上不起作用，但你说它插入第一个矩形好吗？ 它并没有给出错误信息，它只是认为它已经完成了。
我用2002在另一台机器上试过，它在那里工作。这两个版本之间一定有些不同。
谢谢你的帮助。。。在正确的版本中，这正是我想要的。
我也要试试看那部电影。这将是一个很棒的训练工具。 我现在很困惑，因为我在LISP中没有使用任何ACAD命令，所以命令提示的顺序不会有什么不同。但我看不出还能是什么
菲索，有什么想法吗？ 修复。。。您的版本适用于2007年。谢谢 李，
是的，你的程序完美地把它放在左边的第一个矩形上，然后程序就好像正常完成一样结束了。没有错误消息，毫不犹豫。。。它认为它完成了。你的在2002年的机器上工作正常。。。。版本中一定有一些不同。 也许Fixo可以提供一些见解-无论如何，很高兴你的问题现在得到解决-我打赌这会节省你一些时间！ 嗨，伙计
对不起，我无法向你解释
因为我的穷
英语
我只是一个程序员，什么都不是
~'J'~
没问题，顺便说一句，代码不错
页:
1
[2]