lisp代码 求大侠加一下循环
下边的命令能实现点选矩形画窗扇，我是个菜鸟，只会简单拼凑代码，自己加循环老是出错 ，请教大侠如何加循环，能实现一次性选几十个矩形然后都画出窗扇呢，这个对我很重要，感激万分(defun c:zs () ;左窗扇命令****************************************************************
(setvar "CMDECHO" 0)(command ".undo" "g")
(setq kxmian 30 mkxmian 35 ztxmian 30 csxmian 41.5 msxmian 67 ktxingshi 2
dajie 11 dajief2 5.5 blfx 7)
(setq ss (ssget '((0 . "LWPOLYLINE"))) i 0);选择多线段
(setvar "pdmode" 33)
(setvar "osmode" 0)
(setq plst (list))
(repeat (sslength ss)
(setq ssn (ssname ss i) endata (entget ssn))
(foreach x endata (if (= (car x) 10) (setq plst (cons (cdr x) plst))))
(setq i (1+ i))
)
(setq tx (apply 'min (mapcar 'car plst)))
(setq ty (apply 'min (mapcar 'cadr plst)))
(setq tmaxx (apply 'max (mapcar 'car plst)))
(setq tmaxy (apply 'max (mapcar 'cadr plst)))
;LISP矩形坐标提取*********************************
(setq waiweiw (- tmaxx tx) waiweih (- tmaxy ty))
(setq pa (list tx ty))
(setq ww waiweiw hh waiweih)
(setq tmp (polar pa pi dajief2)
wpa (polar tmp (/ pi -2) dajief2)
wpb (polar wpa 0 (+ ww dajie))
wpc (polar wpb (/ pi 2) (+ hh dajie))
wpd (polar wpc pi (+ ww dajie))) ;计算
(command ".pline" wpa wpb wpc wpd "c")
(setq pb (polar pa 0 ww)pc (polar pb (/ pi 2) hh) pd (polar pc pi ww)) ;计算
(setq tmp (polar pa 0 csxmian)) ;计算
(setq mp1 (polar tmp (/ pi 2) csxmian))
(setq mp2 (polar mp1 0 (- ww (* 2 csxmian))))
(setq mp3 (polar mp2 (/ pi 2) (- hh (* 2 csxmian))))
(setq mp4 (polar mp3 pi (- ww (* 2 csxmian))))
(sk_mkpl (list mp1 mp2 mp3 mp4) "细线5" 256 1)
(command ".line" wpa mp1 "" ".line" wpb mp2 "" ".line" wpc mp3 "" ".line" wpd mp4 "")
(setq cblfx (- blfx 0))
(setq tmp2 (polar mp1 0 cblfx);窗扇槽深
bp1 (polar tmp2 (/ pi 2) cblfx)
bp2 (polar bp1 0 (- (- ww (* 2 csxmian)) (* 2 cblfx)))
bp3 (polar bp2 (/ pi 2) (- (- hh (* 2 csxmian)) (* 2 cblfx)))
bp4 (polar bp3 pi (- (- ww (* 2 csxmian)) (* 2 cblfx))))
(sk_mkpl (list bp1 bp2 bp3 bp4) "细线1" 256 1)
(setq tmp3 (polar mp1 0 22))
(setq yp1 (polar tmp3 (/ pi 2) 22)
yp2 (polar yp1 0 (- (- ww (* 2 csxmian)) (* 2 22)))
yp3 (polar yp2 (/ pi 2) (- (- hh (* 2 csxmian)) (* 2 22)))
yp4 (polar yp3 pi (- (- ww (* 2 csxmian)) (* 2 22))))
(setq lin1 (polar mp1 (/ pi 2) 22)) (setq lin2 (polar mp2 (/ pi 2) 22))
(setq lin3 (polar mp3 (/ pi -2) 22)) (setq lin4 (polar mp4 (/ pi -2) 22))
(if (= ktxingshi 1)
(command ".line" lin1 lin2 "" ".line" lin4 lin3 "" ".line" yp2 yp3 "" ".line" yp4 yp1 "")
(progn
(sk_mkpl (list yp1 yp2 yp3 yp4) "细线5" 256 1)
(command ".line" yp1 mp1 "" ".line" yp2 mp2 "" ".line" yp3 mp3 "" ".line" yp4 mp4 "")
)
)
(setq zd1 (polar yp1 (/ pi 2) (/(- (- hh (* 2 csxmian)) (* 2 22)) 2)))
(sk_mkpl (list yp3 zd1 yp2) "细线5" 256 1)
(setq peijian1 (polar pd (/ pi -2) 149));加入配件合页
(setq peijian2 (polar pa (/ pi 2) 149))
(setq peijian3 (polar pb (/ pi 2) (/ hh 2)))
(setq a1 "heye" a2 "czhishou")
(command "insert" a1 peijian1 1 1 0) (command "insert" a1 peijian2 1 1 0) (command "insert" a2 peijian3 1 1 0)
(command "LAYER" "SET" "细线5" "")
(setvar "OSMODE" 16383) (command ".undo" "e")
(princ)
)
;;;(setvar "clayer" "细线5") ;设置当前图层
;;;简单entmake生成直线&直线型多段线函数
;;;by edata @2014-1-10
;;;p10 起点 p11终点l_lay "图层名" l_col 0-256
(defun sk_mkline(p10 p11 l_lay l_col)
(entmake(list '(0 . "line")
(cons 8 l_lay)
(cons 62 l_col)
(cons 10 p10)
(cons 11 p11)
))
)
;;;pts 多段线点表 l_lay "图层名" l_col 0-256 l_closed 1关闭 0打开
(defun sk_mkpl(pts l_lay l_col l_closed / pt)
(entmake (append
(list '(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
(cons 8 l_lay)
(cons 62 l_col)
(cons 90 (length pts))
(cons 70 l_closed)
)
(mapcar '(lambda (pt)(cons 10 pt)) pts ))
)
)
-----------------------还有一个地方，将(setq plst (list))
放置到repeat中。。另外，最后一个图层切换用(setvar "clayer" "细线5") ;设置当前图层
如果使用enmake生成线，不需要切换当前图层，
只有插入块的地方，需要切换，
插入块也可以用entmake生成，所以到最后，图层都不需要更改。(defun c:zs () ;左窗扇命令****************************************************************
(setvar "CMDECHO" 0)(command ".undo" "g")
(setq kxmian 30 mkxmian 35 ztxmian 30 csxmian 41.5 msxmian 67 ktxingshi 2
dajie 11 dajief2 5.5 blfx 7)
(setq ss (ssget '((0 . "LWPOLYLINE"))) i 0);选择多线段
(setvar "pdmode" 33)
(setvar "osmode" 0)
(repeat (sslength ss)
(setq plst (list))
(setq ssn (ssname ss i) endata (entget ssn))
(foreach x endata (if (= (car x) 10) (setq plst (cons (cdr x) plst))))
(setq i (1+ i))
(setq tx (apply 'min (mapcar 'car plst)))
(setq ty (apply 'min (mapcar 'cadr plst)))
(setq tmaxx (apply 'max (mapcar 'car plst)))
(setq tmaxy (apply 'max (mapcar 'cadr plst)))
;LISP矩形坐标提取*********************************
(setq waiweiw (- tmaxx tx) waiweih (- tmaxy ty))
(setq pa (list tx ty))
(setq ww waiweiw hh waiweih)
(setq tmp (polar pa pi dajief2)
wpa (polar tmp (/ pi -2) dajief2)
wpb (polar wpa 0 (+ ww dajie))
wpc (polar wpb (/ pi 2) (+ hh dajie))
wpd (polar wpc pi (+ ww dajie))) ;计算
(command ".pline" wpa wpb wpc wpd "c")
(setq pb (polar pa 0 ww)pc (polar pb (/ pi 2) hh) pd (polar pc pi ww)) ;计算
(setq tmp (polar pa 0 csxmian)) ;计算
(setq mp1 (polar tmp (/ pi 2) csxmian))
(setq mp2 (polar mp1 0 (- ww (* 2 csxmian))))
(setq mp3 (polar mp2 (/ pi 2) (- hh (* 2 csxmian))))
(setq mp4 (polar mp3 pi (- ww (* 2 csxmian))))
(sk_mkpl (list mp1 mp2 mp3 mp4) "细线5" 256 1)
(command ".line" wpa mp1 "" ".line" wpb mp2 "" ".line" wpc mp3 "" ".line" wpd mp4 "")
(setq cblfx (- blfx 0))
(setq tmp2 (polar mp1 0 cblfx);窗扇槽深
bp1 (polar tmp2 (/ pi 2) cblfx)
bp2 (polar bp1 0 (- (- ww (* 2 csxmian)) (* 2 cblfx)))
bp3 (polar bp2 (/ pi 2) (- (- hh (* 2 csxmian)) (* 2 cblfx)))
bp4 (polar bp3 pi (- (- ww (* 2 csxmian)) (* 2 cblfx))))
(sk_mkpl (list bp1 bp2 bp3 bp4) "细线1" 256 1)
(setq tmp3 (polar mp1 0 22))
(setq yp1 (polar tmp3 (/ pi 2) 22)
yp2 (polar yp1 0 (- (- ww (* 2 csxmian)) (* 2 22)))
yp3 (polar yp2 (/ pi 2) (- (- hh (* 2 csxmian)) (* 2 22)))
yp4 (polar yp3 pi (- (- ww (* 2 csxmian)) (* 2 22))))
(setq lin1 (polar mp1 (/ pi 2) 22)) (setq lin2 (polar mp2 (/ pi 2) 22))
(setq lin3 (polar mp3 (/ pi -2) 22)) (setq lin4 (polar mp4 (/ pi -2) 22))
(if (= ktxingshi 1)
(command ".line" lin1 lin2 "" ".line" lin4 lin3 "" ".line" yp2 yp3 "" ".line" yp4 yp1 "")
(progn
(sk_mkpl (list yp1 yp2 yp3 yp4) "细线5" 256 1)
(command ".line" yp1 mp1 "" ".line" yp2 mp2 "" ".line" yp3 mp3 "" ".line" yp4 mp4 "")
)
)
(setq zd1 (polar yp1 (/ pi 2) (/(- (- hh (* 2 csxmian)) (* 2 22)) 2)))
(sk_mkpl (list yp3 zd1 yp2) "细线5" 256 1)
(setq peijian1 (polar pd (/ pi -2) 149));加入配件合页
(setq peijian2 (polar pa (/ pi 2) 149))
(setq peijian3 (polar pb (/ pi 2) (/ hh 2)))
(setq a1 "heye" a2 "czhishou")
(command "insert" a1 peijian1 1 1 0) (command "insert" a1 peijian2 1 1 0) (command "insert" a2 peijian3 1 1 0)
(setvar "clayer" "细线5") ;设置当前图层
)
(setvar "OSMODE" 16383) (command ".undo" "e")
(princ)
)
;;;(setvar "clayer" "细线5") ;设置当前图层
;;;简单entmake生成直线&直线型多段线函数
;;;by edata @2014-1-10
;;;p10 起点 p11终点l_lay "图层名" l_col 0-256
(defun sk_mkline(p10 p11 l_lay l_col)
(entmake(list '(0 . "line")
(cons 8 l_lay)
(cons 62 l_col)
(cons 10 p10)
(cons 11 p11)
))
)
;;;pts 多段线点表 l_lay "图层名" l_col 0-256 l_closed 1关闭 0打开
(defun sk_mkpl(pts l_lay l_col l_closed / pt)
(entmake (append
(list '(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
(cons 8 l_lay)
(cons 62 l_col)
(cons 90 (length pts))
(cons 70 l_closed)
)
(mapcar '(lambda (pt)(cons 10 pt)) pts ))
)
) 没记错的话，应该是将你的repeat的结束括号移动(setvar "osmode"16383)之前。 entmake图块版
因为entmake生成的时候，设置了图层，如果图层不存在，会自动建立图层，除了层名，
其他的都是默认，图块名一定要存在，不然图块不插入。(defun c:zs () ;左窗扇命令****************************************************************
(setvar "CMDECHO" 0)(command ".undo" "g")
(setq kxmian 30 mkxmian 35 ztxmian 30 csxmian 41.5 msxmian 67 ktxingshi 2
dajie 11 dajief2 5.5 blfx 7)
(setq ss (ssget '((0 . "LWPOLYLINE"))) i 0);选择多线段
(setvar "pdmode" 33)
(setvar "osmode" 0)
(if ss
(repeat (sslength ss)
(setq plst (list))
(setq ssn (ssname ss i) endata (entget ssn))
(foreach x endata (if (= (car x) 10) (setq plst (cons (cdr x) plst))))
(setq i (1+ i))
(setq tx (apply 'min (mapcar 'car plst)))
(setq ty (apply 'min (mapcar 'cadr plst)))
(setq tmaxx (apply 'max (mapcar 'car plst)))
(setq tmaxy (apply 'max (mapcar 'cadr plst)))
;LISP矩形坐标提取*********************************
(setq waiweiw (- tmaxx tx) waiweih (- tmaxy ty))
(setq pa (list tx ty))
(setq ww waiweiw hh waiweih)
(setq tmp (polar pa pi dajief2)
wpa (polar tmp (/ pi -2) dajief2)
wpb (polar wpa 0 (+ ww dajie))
wpc (polar wpb (/ pi 2) (+ hh dajie))
wpd (polar wpc pi (+ ww dajie))) ;计算
(sk_mkpl (list wpa wpb wpc wpd) "细线5" 256 1)
;(command ".pline" wpa wpb wpc wpd "c")
(setq pb (polar pa 0 ww)pc (polar pb (/ pi 2) hh) pd (polar pc pi ww)) ;计算
(setq tmp (polar pa 0 csxmian)) ;计算
(setq mp1 (polar tmp (/ pi 2) csxmian))
(setq mp2 (polar mp1 0 (- ww (* 2 csxmian))))
(setq mp3 (polar mp2 (/ pi 2) (- hh (* 2 csxmian))))
(setq mp4 (polar mp3 pi (- ww (* 2 csxmian))))
(sk_mkpl (list mp1 mp2 mp3 mp4) "细线5" 256 1)
(foreach n (list(list wpa mp1)(list wpb mp2)(list wpc mp3)(list wpd mp4)) (sk_mkline (car n)(cadr n) "细线5" 256))
;(command ".line" wpa mp1 "" ".line" wpb mp2 "" ".line" wpc mp3 "" ".line" wpd mp4 "")
(setq cblfx (- blfx 0))
(setq tmp2 (polar mp1 0 cblfx);窗扇槽深
bp1 (polar tmp2 (/ pi 2) cblfx)
bp2 (polar bp1 0 (- (- ww (* 2 csxmian)) (* 2 cblfx)))
bp3 (polar bp2 (/ pi 2) (- (- hh (* 2 csxmian)) (* 2 cblfx)))
bp4 (polar bp3 pi (- (- ww (* 2 csxmian)) (* 2 cblfx))))
(sk_mkpl (list bp1 bp2 bp3 bp4) "细线1" 256 1)
(setq tmp3 (polar mp1 0 22))
(setq yp1 (polar tmp3 (/ pi 2) 22)
yp2 (polar yp1 0 (- (- ww (* 2 csxmian)) (* 2 22)))
yp3 (polar yp2 (/ pi 2) (- (- hh (* 2 csxmian)) (* 2 22)))
yp4 (polar yp3 pi (- (- ww (* 2 csxmian)) (* 2 22))))
(setq lin1 (polar mp1 (/ pi 2) 22)) (setq lin2 (polar mp2 (/ pi 2) 22))
(setq lin3 (polar mp3 (/ pi -2) 22)) (setq lin4 (polar mp4 (/ pi -2) 22))
(if (= ktxingshi 1)
(foreach n (list(list lin1 lin2)(list lin4 lin3)(list yp2 yp3)(list yp4 yp1)) (sk_mkline (car n)(cadr n) "细线5" 256))
;(command ".line" lin1 lin2 "" ".line" lin4 lin3 "" ".line" yp2 yp3 "" ".line" yp4 yp1 "")
(progn
(sk_mkpl (list yp1 yp2 yp3 yp4) "细线5" 256 1)
(foreach n (list(list yp1 mp1)(list yp2 mp2)(list yp3 mp3)(list yp4 mp4)) (sk_mkline (car n)(cadr n) "细线5" 256))
;(command ".line" yp1 mp1 "" ".line" yp2 mp2 "" ".line" yp3 mp3 "" ".line" yp4 mp4 "")
)
)
(setq zd1 (polar yp1 (/ pi 2) (/(- (- hh (* 2 csxmian)) (* 2 22)) 2)))
(sk_mkpl (list yp3 zd1 yp2) "细线5" 256 0);不闭合0
(setq peijian1 (polar pd (/ pi -2) 149));加入配件合页
(setq peijian2 (polar pa (/ pi 2) 149))
(setq peijian3 (polar pb (/ pi 2) (/ hh 2)))
(setq a1 "heye" a2 "czhishou")
(mk_blk a1 peijian1 "配件" 256)
(mk_blk a1 peijian2 "配件" 256)
(mk_blk a2 peijian3 "配件" 256)
;(setvar "clayer" "细线5") ;设置当前图层
)
)
(setvar "OSMODE" 16383) (command ".undo" "e")
(princ)
)
;;;(setvar "clayer" "细线5") ;设置当前图层
;;;简单entmake生成直线&直线型多段线函数
;;;by edata @2014-1-10
;;;p10 起点 p11终点l_lay "图层名" l_col 0-256
(defun sk_mkline(p10 p11 l_lay l_col)
(entmake(list '(0 . "line")
(cons 8 l_lay)
(cons 62 l_col)
(cons 10 p10)
(cons 11 p11)
))
)
;;;pts 多段线点表 l_lay "图层名" l_col 0-256 l_closed 1关闭 0打开
(defun sk_mkpl(pts l_lay l_col l_closed / pt)
(entmake (append
(list '(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
(cons 8 l_lay)
(cons 62 l_col)
(cons 90 (length pts))
(cons 70 l_closed)
)
(mapcar '(lambda (pt)(cons 10 pt)) pts ))
)
)
;;;插入普通块简单版
;;;lk_name "块名" ipt 插入点 l_lay "图层名" l_col 0-256颜色
(defun mk_blk(blk_name ipt l_lay l_col)
(entmake (list '(0 . "INSERT")
(cons 8 l_lay)
(cons 62 l_col)
(cons 2 blk_name)
(cons 10 ipt)
)
)
) 本帖最后由 kwok 于 2014-1-12 13:52 编辑
看标题问题已解决，是不是要把悬赏币送出？
选最值答案就ok
页:
[1]