各位大神帮忙看看，像这个填充lisp要怎么实现呢?
本帖最后由 ＿Levin 于 2015-7-7 19:21 编辑http://bbs.mjtd.com/forum.php?mod=image&aid=89082&size=300x300&key=d8f9c4d8ffe3e1c2&nocache=yes&type=fixnone
用一个命令，点方框内任意一点，实现右边这个类似填充的功能，
里面的方块是30*30，
方块的框可以实现是8号颜色吗？然后交叉线是250号颜色，
剩下的是138号颜色
lisp应该要怎么写呢？ 1.首先方框要矩形，并且是封闭的，没有多余控制点，
2.取出矩形长宽
3.用polar函数取出各个点坐标
4.建图层，设当前层
5.command画线 本帖最后由 edata 于 2015-7-8 13:46 编辑
(vl-load-com)
(defun c:tt(/ p e1 e2 e3 pts1 pts2 bak_color bak_echo p1 p2 p3 p4 p5 p6 p7 p8)
(if(setq p(getpoint "\n指定点"))
(progn
(setq e1(entlast))
(setq bak_echo (getvar 'cmdecho))
(setvar 'cmdecho 0)
(command "-BOUNDARY" "_non" p "")
(setq e2(entlast))
(if(and (sk_eqh5 e1 e2) (sk_type e2 "LWPOLYLINE"))
(progn
(command "offset" "30" e2 "_non" p "")
(setq e3(entlast))
(vla-put-color (vlax-ename->vla-object e3) 138)
(if (and (sk_eqh5 e2 e3) (sk_type e3 "LWPOLYLINE"))
(progn
(setq pts1(sk_getpt e2))
(setq pts2(sk_getpt e3))
(mapcar 'set '(p1 p2 p3 p4) (mapcar '(lambda(x)(trans x 0 1 )) pts1))
(mapcar 'set '(p5 p6 p7 p8) (mapcar '(lambda(x)(trans x 0 1 )) pts2))
(setq bak_color(getvar 'cecolor))
(setvar 'cecolor "8")
(command "rectang" "_non" p1 "_non" p5)
(sk_mkdj (entlast))
(command "rectang" "_non" p2 "_non" p6)
(sk_mkdj (entlast))
(command "rectang" "_non" p3 "_non" p7)
(sk_mkdj (entlast))
(command "rectang" "_non" p4 "_non" p8)
(sk_mkdj (entlast))
(setvar 'cecolor bak_color)
(setvar 'cmdecho bak_echo)
(entdel e2)
)
)
)
)
)
)
(princ)
)
(defun sk_eqh5(e1 e2)(not(equal (sk_dxf e1 5)(sk_dxf e2 5))))
(defun sk_dxf(ent code)(cdr(assoc code(entget ent))))
(defun sk_type(ent str)(equal (sk_dxf ent 0) str))
(defun sk_getpt(ent)(mapcar 'cdr (vl-remove-if-not '(lambda(x)(= 10 (car x)))(entget ent))))
(defun sk_mkdj(ent / p1 p2 p3 p4 pts bak_color)
(setq pts (sk_getpt ent))
(mapcar 'set '(p1 p2 p3 p4) (mapcar '(lambda(x)(trans x 0 1 )) pts))
(setq bak_color(getvar 'cecolor))
(setvar 'cecolor "250")
(command "line" "_non" p1 "_non" p3 "")
(command "line" "_non" p2 "_non" p4 "")
(setvar 'cecolor bak_color)
)
楼上体力活啊，如果有多余控制点的BOUNDARY，如下图，程序就会出错
edata 发表于 2015-7-8 11:08 static/image/common/back.gif
试试看，谢谢大神 fan_zh 发表于 2015-7-8 11:20 static/image/common/back.gif
楼上体力活啊，如果有多余控制点的BOUNDARY，如下图，程序就会出错
谁叫你要弄多两个控制点呢那么你叫大神继续改进下 本帖最后由 ＿Levin 于 2015-7-8 15:27 编辑
edata 发表于 2015-7-8 11:08 static/image/common/back.gif
http://bbs.mjtd.com/forum.php?mod=image&aid=89094&size=300x300&key=b6546d7d46ec838c&nocache=yes&type=fixnone
大神，我这是几个rec画出来的方框，挨着一起填充就出错了。。怎么办
刚才还发现另一个问题，能做到连续填充的吗？
现在是点一下，变回了十字光标，又要按一下才能继续填充 本帖最后由 cable2004 于 2015-7-8 15:55 编辑
(command "-BOUNDARY" "_non" p "") 会多节点
(defun c:tt ()
(setvar "CMDECHO" 0)
(if (setq ss (ssget '((0 . "LWPOLYLINE") (90 . 4)))) (progn
(setq i -1 k 30)
(repeat (sslength ss)
(setq ent (entget(ssname ss (setq i (1+ i)))))
(setq lst (list) pts (list))
(foreach x ent (if (= (car x) 10) (setq lst (cons (cdr x) lst))))
(mapcar '(lambda (x y)
(setq ang (angle x y)
p1(polar x ang k)
p2(polar x (+ (* 0.25 pi) ang) (* (sqrt 2) k))
p3(polar x (+ (* 0.5 pi) ang) k)
)
(entmake-Line p2 p3)
(entmake-Line p2 p1)
(entmake-Line x p2)
(entmake-Line p3 p1)
(setq pts (cons p2 pts))
)
(cons (last lst)lst)lst)
(entmake-Line (car pts) (cadr pts))
(entmake-Line (cadr pts) (caddr pts))
(entmake-Line (caddr pts) (cadddr pts))
(entmake-Line (cadddr pts) (car pts))
)))
(setvar "CMDECHO" 1)
(princ)
)
(defun entmake-Line (p1 p2 )
(entmakex (list (cons 0 "LINE") (cons 10 p1)(cons 11 p2)(cons 62 1))))
＿Levin 发表于 2015-7-8 15:21 static/image/common/back.gif
大神，我这是几个rec画出来的方框，挨着一起填充就出错了。。怎么办
刚才还发现另一个问题，能做 ...
目测没有关闭捕捉
在程序开头加上
(setvar 'osmode 0) (vl-load-com)
(defun c:tt(/ p e1 e2 e3 pts1 pts2 bak_color bak_echo p1 p2 p3 p4 p5 p6 p7 p8)
(if(setq p(getpoint "\n指定点"))
(progn
(setq e1(entlast))
(setq bak_echo (getvar 'cmdecho))
(setvar 'cmdecho 0)
(command "-BOUNDARY" "_non" p "")
(setq e2(entlast))
(if(and (sk_eqh5 e1 e2) (sk_type e2 "LWPOLYLINE"))
(progn
(command "offset" "30" e2 "_non" p "")
(setq e3(entlast))
(vla-put-color (vlax-ename->vla-object e3) 138)
(if (and (sk_eqh5 e2 e3) (sk_type e3 "LWPOLYLINE"))
(progn
(setq pts1(check (sk_getpt e2)))
(setq pts2(check (sk_getpt e3)))
(if (and (= 4 (length pts1))(= 4 (length pts2))) (progn
(mapcar 'set '(p1 p2 p3 p4) (mapcar '(lambda(x)(trans x 0 1 )) pts1))
(mapcar 'set '(p5 p6 p7 p8) (mapcar '(lambda(x)(trans x 0 1 )) pts2))
(setq bak_color(getvar 'cecolor))
(setvar 'cecolor "8")
(command "rectang" "_non" p1 "_non" p5)
(sk_mkdj (entlast))
(command "rectang" "_non" p2 "_non" p6)
(sk_mkdj (entlast))
(command "rectang" "_non" p3 "_non" p7)
(sk_mkdj (entlast))
(command "rectang" "_non" p4 "_non" p8)
(sk_mkdj (entlast))
(setvar 'cecolor bak_color)
(setvar 'cmdecho bak_echo)
(entdel e2)
)))
)
)
)
)
)
(princ)
)
(defun sk_eqh5(e1 e2)(not(equal (sk_dxf e1 5)(sk_dxf e2 5))))
(defun sk_dxf(ent code)(cdr(assoc code(entget ent))))
(defun sk_type(ent str)(equal (sk_dxf ent 0) str))
(defun sk_getpt(ent)(mapcar 'cdr (vl-remove-if-not '(lambda(x)(= 10 (car x)))(entget ent))))
(defun sk_mkdj(ent / p1 p2 p3 p4 pts bak_color)
(setq pts (sk_getpt ent))
(mapcar 'set '(p1 p2 p3 p4) (mapcar '(lambda(x)(trans x 0 1 )) pts))
(setq bak_color(getvar 'cecolor))
(setvar 'cecolor "250")
(command "line" "_non" p1 "_non" p3 "")
(command "line" "_non" p2 "_non" p4 "")
(setvar 'cecolor bak_color)
)
(defun check(lst / pts)
(mapcar '(lambda (x y z)
(if (null (equal (- (distance x z) (distance z y) (distance y x)) 0))
(setq pts (cons y pts))
))
(cons (last lst)lst) lst (append (cdr lst) (list (car lst))))
pts
)
页:
[1]
2