你能帮我查一下这个密码吗？。。。
提前谢谢！。。。 CafeJr，试试这个，如果有什么问题就回答。。。现在，它应该适用于2个相反的开放二维曲线边界。。。
(defun c:snakefill-2curveboundaries (/ *adoc* odd even osm pea ch r lpl upl ip dir lplo uplo spc xl1 c1 xl2 c2 cl ss)
(defun odd (lst)
(if lst (cons (car lst) (odd (cddr lst))))
)
(defun even (lst)
(if lst (cons (cadr lst) (even (cddr lst))))
)
(vl-load-com)
(setq *adoc* (vla-get-activedocument (vlax-get-acad-object)))
(setq osm (getvar 'osmode))
(setq pea (getvar 'peditaccept))
(setvar 'osmode 0)
(command "_.ucs" "w")
(initget 1 "Left-Right Up-Down")
(setq ch (getkword "\nChoose option (Left-Right / Up-Down) curve boundaries: "))
(initget 7)
(setq r (getdist "\nSpecify radius of snake turn: "))
(if (eq ch "Up-Down")
(progn
(setq lpl (car (entsel "\nPick lower curve boundary...")))
(setq upl (car (entsel "\nPick upper curve boundary...")))
(setq ip (getpoint "\nPick start point (\"left\" - Up-Down or \"bottom\" - Left-Right): "))
(initget 1 "Up Down")
(setq dir (getkword "\nChoose start direction (Up / Down): "))
(if (eq dir "Up")
(progn
(command "_.offset" r lpl ip "")
(setq lplo (entlast))
(command "_.offset" r upl ip "")
(setq uplo (entlast))
(setq spc (vla-ObjectIdToObject *adoc* (vla-get-OwnerId (vlax-ename->vla-object lpl))))
(setq c1 T c2 T k -3.0)
(while (and c1 c2)
(setq xl1 (vlax-invoke spc 'addxline (polar ip 0.0 (* r (setq k (+ k 4.0)))) (polar (polar ip 0.0 (* r k)) (* pi 0.5) 1.0)))
(setq c1 (vlax-invoke xl1 'intersectwith (vlax-ename->vla-object uplo) acextendnone))
(vla-delete xl1)
(setq xl2 (vlax-invoke spc 'addxline (polar ip 0.0 (* r (+ k 2.0))) (polar (polar ip 0.0 (* r (+ k 2.0))) (* pi 0.5) 1.0)))
(setq c2 (vlax-invoke xl2 'intersectwith (vlax-ename->vla-object lplo) acextendnone))
(vla-delete xl2)
(if c1 (setq cl (cons c1 cl)))
(if (and c1 c2) (setq cl (cons c2 cl)))
)
(setq cl (reverse cl))
(setq ss (ssadd))
(foreach c (vl-remove nil (odd cl))
(command "_.arc" (polar c pi r) (polar c (* pi 0.5) r) (polar c 0.0 r))
(ssadd (entlast) ss)
)
(foreach c (vl-remove nil (even cl))
(command "_.arc" (polar c pi r) (polar c (* pi -0.5) r) (polar c 0.0 r))
(ssadd (entlast) ss)
)
(mapcar '(lambda (p1 p2) (progn (command "_.line" p1 p2 "") (ssadd (entlast) ss))) (mapcar '(lambda (p) (polar p 0.0 r)) (vl-remove nil (odd cl))) (mapcar '(lambda (p) (polar p pi r)) (vl-remove nil (even cl))))
(mapcar '(lambda (p1 p2) (progn (command "_.line" p1 p2 "") (ssadd (entlast) ss))) (mapcar '(lambda (p) (polar p 0.0 r)) (vl-remove nil (even cl))) (mapcar '(lambda (p) (polar p pi r)) (vl-remove nil (cdr (odd cl)))))
(command "_.line" ip (polar (car cl) pi r) "")
(ssadd (entlast) ss)
)
(progn
(command "_.offset" r lpl ip "")
(setq lplo (entlast))
(command "_.offset" r upl ip "")
(setq uplo (entlast))
(setq spc (vla-ObjectIdToObject *adoc* (vla-get-OwnerId (vlax-ename->vla-object lpl))))
(setq c1 T c2 T k -3.0)
(while (and c1 c2)
(setq xl1 (vlax-invoke spc 'addxline (polar ip 0.0 (* r (setq k (+ k 4.0)))) (polar (polar ip 0.0 (* r k)) (* pi 0.5) 1.0)))
(setq c1 (vlax-invoke xl1 'intersectwith (vlax-ename->vla-object lplo) acextendnone))
(vla-delete xl1)
(setq xl2 (vlax-invoke spc 'addxline (polar ip 0.0 (* r (+ k 2.0))) (polar (polar ip 0.0 (* r (+ k 2.0))) (* pi 0.5) 1.0)))
(setq c2 (vlax-invoke xl2 'intersectwith (vlax-ename->vla-object uplo) acextendnone))
(vla-delete xl2)
(if c1 (setq cl (cons c1 cl)))
(if (and c1 c2) (setq cl (cons c2 cl)))
)
(setq cl (reverse cl))
(setq ss (ssadd))
(foreach c (vl-remove nil (odd cl))
(command "_.arc" (polar c pi r) (polar c (* pi -0.5) r) (polar c 0.0 r))
(ssadd (entlast) ss)
)
(foreach c (vl-remove nil (even cl))
(command "_.arc" (polar c pi r) (polar c (* pi 0.5) r) (polar c 0.0 r))
(ssadd (entlast) ss)
)
(mapcar '(lambda (p1 p2) (progn (command "_.line" p1 p2 "") (ssadd (entlast) ss))) (mapcar '(lambda (p) (polar p 0.0 r)) (vl-remove nil (odd cl))) (mapcar '(lambda (p) (polar p pi r)) (vl-remove nil (even cl))))
(mapcar '(lambda (p1 p2) (progn (command "_.line" p1 p2 "") (ssadd (entlast) ss))) (mapcar '(lambda (p) (polar p 0.0 r)) (vl-remove nil (even cl))) (mapcar '(lambda (p) (polar p pi r)) (vl-remove nil (cdr (odd cl)))))
(command "_.line" ip (polar (car cl) pi r) "")
(ssadd (entlast) ss)
)
)
)
(progn
(setq lpl (car (entsel "\nPick right curve boundary...")))
(setq upl (car (entsel "\nPick left curve boundary...")))
(setq ip (getpoint "\nPick start point (\"left\" - Up-Down or \"bottom\" - Left-Right): "))
(initget 1 "Left Right")
(setq dir (getkword "\nChoose start direction (Left / Right): "))
(if (eq dir "Left")
(progn
(command "_.offset" r lpl ip "")
(setq lplo (entlast))
(command "_.offset" r upl ip "")
(setq uplo (entlast))
(setq spc (vla-ObjectIdToObject *adoc* (vla-get-OwnerId (vlax-ename->vla-object lpl))))
(setq c1 T c2 T k -3.0)
(while (and c1 c2)
(setq xl1 (vlax-invoke spc 'addxline (polar ip (* pi 0.5) (* r (setq k (+ k 4.0)))) (polar (polar ip (* pi 0.5) (* r k)) 0.0 1.0)))
(setq c1 (vlax-invoke xl1 'intersectwith (vlax-ename->vla-object uplo) acextendnone))
(vla-delete xl1)
(setq xl2 (vlax-invoke spc 'addxline (polar ip (* pi 0.5) (* r (+ k 2.0))) (polar (polar ip (* pi 0.5) (* r (+ k 2.0))) 0.0 1.0)))
(setq c2 (vlax-invoke xl2 'intersectwith (vlax-ename->vla-object lplo) acextendnone))
(vla-delete xl2)
(if c1 (setq cl (cons c1 cl)))
(if (and c1 c2) (setq cl (cons c2 cl)))
)
(setq cl (reverse cl))
(setq ss (ssadd))
(foreach c (vl-remove nil (odd cl))
(command "_.arc" (polar c (* pi -0.5) r) (polar c pi r) (polar c (* pi 0.5) r))
(ssadd (entlast) ss)
)
(foreach c (vl-remove nil (even cl))
(command "_.arc" (polar c (* pi -0.5) r) (polar c 0.0 r) (polar c (* pi 0.5) r))
(ssadd (entlast) ss)
)
(mapcar '(lambda (p1 p2) (progn (command "_.line" p1 p2 "") (ssadd (entlast) ss))) (mapcar '(lambda (p) (polar p (* pi 0.5) r)) (vl-remove nil (odd cl))) (mapcar '(lambda (p) (polar p (* pi -0.5) r)) (vl-remove nil (even cl))))
(mapcar '(lambda (p1 p2) (progn (command "_.line" p1 p2 "") (ssadd (entlast) ss))) (mapcar '(lambda (p) (polar p (* pi 0.5) r)) (vl-remove nil (even cl))) (mapcar '(lambda (p) (polar p (* pi -0.5) r)) (vl-remove nil (cdr (odd cl)))))
(command "_.line" ip (polar (car cl) (* pi -0.5) r) "")
(ssadd (entlast) ss)
)
(progn
(command "_.offset" r lpl ip "")
(setq lplo (entlast))
(command "_.offset" r upl ip "")
(setq uplo (entlast))
(setq spc (vla-ObjectIdToObject *adoc* (vla-get-OwnerId (vlax-ename->vla-object lpl))))
(setq c1 T c2 T k -3.0)
(while (and c1 c2)
(setq xl1 (vlax-invoke spc 'addxline (polar ip (* pi 0.5) (* r (setq k (+ k 4.0)))) (polar (polar ip (* pi 0.5) (* r k)) 0.0 1.0)))
(setq c1 (vlax-invoke xl1 'intersectwith (vlax-ename->vla-object lplo) acextendnone))
(vla-delete xl1)
(setq xl2 (vlax-invoke spc 'addxline (polar ip (* pi 0.5) (* r (+ k 2.0))) (polar (polar ip (* pi 0.5) (* r (+ k 2.0))) 0.0 1.0)))
(setq c2 (vlax-invoke xl2 'intersectwith (vlax-ename->vla-object uplo) acextendnone))
(vla-delete xl2)
(if c1 (setq cl (cons c1 cl)))
(if (and c1 c2) (setq cl (cons c2 cl)))
)
(setq cl (reverse cl))
(setq ss (ssadd))
(foreach c (vl-remove nil (odd cl))
(command "_.arc" (polar c (* pi -0.5) r) (polar c 0.0 r) (polar c (* pi 0.5) r))
(ssadd (entlast) ss)
)
(foreach c (vl-remove nil (even cl))
(command "_.arc" (polar c (* pi -0.5) r) (polar c pi r) (polar c (* pi 0.5) r))
(ssadd (entlast) ss)
)
(mapcar '(lambda (p1 p2) (progn (command "_.line" p1 p2 "") (ssadd (entlast) ss))) (mapcar '(lambda (p) (polar p (* pi 0.5) r)) (vl-remove nil (odd cl))) (mapcar '(lambda (p) (polar p (* pi -0.5) r)) (vl-remove nil (even cl))))
(mapcar '(lambda (p1 p2) (progn (command "_.line" p1 p2 "") (ssadd (entlast) ss))) (mapcar '(lambda (p) (polar p (* pi 0.5) r)) (vl-remove nil (even cl))) (mapcar '(lambda (p) (polar p (* pi -0.5) r)) (vl-remove nil (cdr (odd cl)))))
(command "_.line" ip (polar (car cl) (* pi -0.5) r) "")
(ssadd (entlast) ss)
)
)
)
)
(setvar 'peditaccept 1)
(command "_.pedit" "m" ss "" "j" "" "")
(entdel lplo)
(entdel uplo)
(setvar 'osmode osm)
(setvar 'peditaccept pea)
(command "_.ucs" "p")
(princ)
)
(defun c:sf-2c nil (c:snakefill-2curveboundaries))
(prompt "\n...Run with 'SF-2C'...")
(princ)
M.R。 Marko_ribar非常非常好新的，可以解决 谢谢你，比格尔。。。我将附上更完整的版本-它确定拾取点的位置，并根据该位置继续将蛇绘制到曲线之间区域的另一侧。。。
M、 R。
蛇形填充-2曲线边界。lsp
哇。。。非常感谢Marko_ribar！！！。。。这正是我需要的！！！。。。我很感激！！！。。。它的工作，因为我需要好！。。。
Marko_ribar大师，
我不知道这是否是另一个线程，但是，我想这段代码将是一个“esay”代码，我真的很震惊！这是一个很大的代码，不是那么容易！！！。。。那么，对于这个代码，遵循边界平面图的一条参考线，如图所示，有可能吗？
非常感谢！！！。。。我真的很感激！！！。。。
如果第三个边界是一个弧，我认为这是可能的。。。但弯曲必须在第一和第二侧边界之间-像圆这样的东西是不可能的。。。我认为这是一个在垂直向上/向下方向上，而不是偏移第三个边界的多个副本的示例。。。正如我所说的，如果它比它可能的弧。。。原理与上面发布的代码相同。。。只需在水平/垂直方向上与圆弧相交，而不需要连接线。。。我认为你有很多信息可以自己构建这个。。。如果你愿意，你可以向我们展示你的结果。。。我们很高兴看到它能起作用。。。请记住，在搜索边弧的中心时，我会使用“intersectwith method with option acextendthisentity（弧是第一个VLA-OBJECT）。。。
M、 R。
事实上，边界线是一个区域的普林斯极限，我必须填充它，就像下一张图片。。。我试着按照一些规则用“蛇线”填充它。我可以说这只是绘画的第一步！但最糟糕的是。。。
编辑：Opsss。。。对不起，但是，你是要我给你看结果吗？
我不知道该怎么做，我正在研究另一种方法，但试图编译另一种代码！。。。 这是Lisp程序。。。它将圆弧用作第三个边界。。。第一和第二侧边界必须是水平或垂直曲线。。。
我没有使用acextendthisentity，但必须重新创建半圆弧。。。
M、 R。
[编辑：我不知道为什么，但它在2012年不起作用，在2014年起作用]。。。
[EDIT2:现在可以在版本上使用
snakefill-2lineboundaries-arc-entmake arcs。lsp
马可·里巴，非常感谢你帮助我！！！。。。几乎是这样，在最后两张图片上，你可以看到要遵循的线是边界线（在这种情况下是一条水平线），而不是绘制一条弧，可以选择该线作为参考线？在那之后做从上侧到下侧的偏移，用圆弧闭合。。。我试着编译代码，比如在这种情况下，在做了一个“pedit”连接这些对象之后，偏移了直线和圆弧。。。
页:
1
[2]