多段线上的GRVEC
大家好，最近几天，我试图在闭合多段线的顶点上做一些事情。
仍不成功。。那么，你能看看可能出了什么问题吗
(setq bply-verts (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) bply-elist)))
(grvecs (list -3 bply-verts)) ; <- I've seen Tharwat doing something like this, instead of whats been written in HELP
我仍然在想到底出了什么问题，因为我不能使用“MkWipeout”子函数——即使我提供了正确的点列表。 4件事：
1.
我无法复制您的错误消息（“自动错误。对象已被擦除”）。
2.
我必须更改命令调用（注意：我使用BricsCAD而不是AutoCAD）：
（vl cmdf“_。-boundary”“\u advanced”“\u island”“\u no”“pt”“）
为了便于阅读，我不希望缩写命令选项。
3.
函数grvecs需要不同格式的列表。
在最初的帖子中，您有：
（GRVEC（列表3（列表ptA ptB ptC ptD）））
这必须是：
（grvecs（列表-3 ptA ptB ptB ptC ptD ptD ptA））
实现这一点的一种方法：
Command: test
Pick a point inside a closed boundary: Automation Error. Object was erased4。
为了使MkWipeout生成的擦除正确显示，我必须将（70.7）添加到entmakex列表中：
;;Requires a point list and layer name
(defun MkWipeout (lst lay / c m p)
(setq lst (cons (last lst) lst)
p (apply 'mapcar (cons 'min lst))
m (apply 'max (mapcar '- (apply 'mapcar (cons 'max lst)) p))
c (mapcar '+ p (list (/ m 2.0) (/ m 2.0)))
)
(entmakex
(append
(list
'(000 . "WIPEOUT")
'(100 . "AcDbEntity")
'(100 . "AcDbWipeout")
(cons 8 lay)
(cons 10 (trans p 1 0))
(cons 11 (trans (list m 0.0) 1 0))
(cons 12 (trans (list 0.0 m) 1 0))
'(280 . 1)
'(071 . 2)
)
(mapcar
(function
(lambda (x)
(cons 14 (mapcar '(lambda (a b c) (/ (- a b) c)) x c (list m (- m)))))) lst)))
) 下面是另一种选择，使用grdraw：
PS:FWIW，擦除代码实际上是我从这个线程得到的。 非常感谢你的修改和帮助，罗伊！
正确使用上述解决方案中的GRVEC或grdraw时，自动化错误消失。
我不太擅长列表操作，很明显，我很高兴在这个论坛上有一个更有经验的LISPer回复。
李，很抱歉造成了混乱。。我指的是CAB的子功能，它是根据您最初的wipeout代码创建的（我从同一个线程中获取），但现在我将使用您的LM:polywipeout。
aa谢谢你的替代代码！
我最初的想法是从闭合多段线创建一个覆盖，但后来我决定练习使用GRVEC和grtext。
现在有趣的是，所有发布的解决方案都可以工作，但不会使实际的结果消失（至少在我尝试我的计算机时）。有人能证实这一点吗？ Here is an alternative, using grdraw:
(defun c:test ( / *error* enl enx lst ply pnt ) (defun *error* ( msg ) (if (and (= 'ename (type ply)) (entget ply)) (entdel ply)) (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")) (princ (strcat "\nError: " msg)) ) (redraw) (grtext) (princ) ) (while (setq pnt (getpoint "\nPick a point within a closed boundary : ")) (redraw) (setq enl (entlast)) (vl-cmdf "_.-boundary" "_A" "_I" "_N" "" "_O" "_P" "" "_non" pnt "") (if (and (not (eq enl (setq ply (entlast)))) (setq enx (entget ply)) (= "LWPOLYLINE" (cdr (assoc 0 enx))) (= 1 (logand 1 (cdr (assoc 70 enx)))) ) (progn (mapcar '(lambda ( a b ) (grdraw a b 3 1)) (setq lst (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= 10 (car x))) enx))) (cons (last lst) lst) ) (LM:polywipeout lst) (grtext -1 (strcat "Enclosed area: " (rtos (vlax-curve-getarea ply) 2 0) " m2")) (entdel ply) ) (princ "\nNo valid boundary found.") ) ) (redraw) (grtext) (princ));; Polygonal Wipeout-Lee Mac;; Constructs a polygonal wipeout with vertices positioned at the supplied coordinates.;; l - List of wipeout vertices (UCS)(defun LM:polywipeout ( l / c m p ) (setq l (cons (last l) l) p (apply 'mapcar (cons 'min l)) m (apply 'max (mapcar '- (apply 'mapcar (cons 'max l)) p)) c (mapcar '+ p (list (/ m 2.0) (/ m 2.0))) ) (entmakex (append (list '(000 . "WIPEOUT") '(100 . "AcDbEntity") '(100 . "AcDbWipeout") (cons 10 (trans p 1 0)) (cons 11 (trans (list m 0.0) 1 0)) (cons 12 (trans (list 0.0 m) 1 0)) '(280 . 1) '(070 . 7) '(071 . 2) ) (mapcar (function (lambda ( x ) (cons 14 (mapcar '(lambda ( a b c ) (/ (- a b) c)) x c (list m (- m)))) ) ) l ) ) ))(vl-load-com) (princ)PS: FWIW, the wipeout code is actually mine from this thread. Thanks alot for your revision and help, Roy!
The automation error disappeared when using correctly grvecs or grdraw from the solutions above.
I'm not that good with list manipulation, obviously and I'm happy that theres one more experienced LISPer in this forum who replies.
Sorry for the created confusion, Lee.. I was refering to CAB's subfunction - created from your original wipeout code (I took it from the same thread) but now I'll use your LM:polywipeout instead.
Aaand thanks for the alternative code!
My initial idea was to create a wipeout from a closed polyline, but then I've decided to put some practice with using grvecs and grtext.
Now the funny thing is that all of the posted solutions work, but won't entmakex the actual wipeout (atleast when I try on my computer). Can anyone confirm this?
页:
[1]