求大侠帮忙优化一下lisp代码
求大侠帮忙优化一下代码，图纸里内容少的时候运行的还可以，可是稍一多点运行奇慢，往往一个命令得10多秒，实在是受不了，下边的代码目的是选择矩形框，然后生成窗扇，很多命令都是瞎拼凑的，很不规范也很啰嗦，请求大侠帮忙优化一下代码， 非常感激zs(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) i 0);选择多线段
(setvar "pdmode" 33) (setvar "osmode" 0)
(setq tx 10000000000000000 ty 10000000000000000);定义临时变量
(setq tmaxx -10000000000000000 tmaxy -10000000000000000);定义临时变量
(setq waiweiw 0 waiweih 0)
(repeat (sslength ss)
(setq ssn (ssname ss i) endata (entget ssn))(setq n 0 xh 1) (terpri)
(repeat (length endata)
(setq pp (nth n endata)key (car pp))
(if (= key 10)
(progn (setq x1 (cadr pp) y1 (caddr pp))
(setq x (rtos x1 2 4) y (rtos y1 2 4))
(setq PP (list x1 y1))
(if (> tx x1 ) (progn (setq tx x1)) )
(if (> ty y1 ) (progn (setq ty y1)) )
(if (< tmaxx x1 ) (progn (setq tmaxx x1)) )
(if (< tmaxy y1 ) (progn (setq tmaxy y1)) )
(setq xh (1+ xh))
)
)
(setq n (1+ n))
)
(setq i (1+ i))
);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))))
(command ".pline" mp1 mp2 mp3 mp4 "c")
(command ".line" wpa mp1 "") (command ".line" wpb mp2 "") (command ".line" wpc mp3 "") (command ".line" wpd mp4 "")
(COMMAND "LAYER" "SET" "细线1" "")
(setq cblfx (- blfx 0)) (setq tmp2 (polar mp1 0 cblfx));窗扇槽深
(setq bp1 (polar tmp2 (/ pi 2) cblfx)) (setq bp2 (polar bp1 0 (- (- ww (* 2 csxmian)) (* 2 cblfx))))
(setq bp3 (polar bp2 (/ pi 2) (- (- hh (* 2 csxmian)) (* 2 cblfx)))) (setq bp4 (polar bp3 pi (- (- ww (* 2 csxmian)) (* 2 cblfx))))
(command ".pline" bp1 bp2 bp3 bp4 "c")
(COMMAND "LAYER" "SET" "细线5" "")
(setq tmp3 (polar mp1 0 22))
(setq yp1 (polar tmp3 (/ pi 2) 22))
(setq yp2 (polar yp1 0 (- (- ww (* 2 csxmian)) (* 2 22))))
(setq yp3 (polar yp2 (/ pi 2) (- (- hh (* 2 csxmian)) (* 2 22))))
(setq yp4 (polar yp3 pi (- (- ww (* 2 csxmian)) (* 2 22))))
;(command ".pline" yp1 yp2 yp3 yp4 "c")
(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)
(progn (command ".line" lin1 lin2 "") (command ".line" lin4 lin3 "")
(command ".line" yp2 yp3 "") (command ".line" yp4 yp1 "") )
(progn (command ".pline" yp1 yp2 yp3 yp4 "c")
(command ".line" yp1 mp1 "") (command ".line" yp2 mp2 "")
(command ".line" yp3 mp3 "") (command ".line" yp4 mp4 ""))
)
(setq zd1 (polar yp1 (/ pi 2) (/(- (- hh (* 2 csxmian)) (* 2 22)) 2)))
(command ".pline" yp3 zd1 yp2 "")
(COMMAND "LAYER" "SET" "配件" "")
(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" b "1"b1 "1" an "0" ) (setq a2 "czhishou" b "1"b1 "1" an "0" )
(command "insert" a1 peijian1 b b1 an) (command "insert" a1 peijian2 b b1 an) (command "insert" a2 peijian3 b b1 an)
(COMMAND "LAYER" "SET" "细线5" "")
(setvar "OSMODE" 16383) (command ".undo" "e") (princ)
);窗扇命令***********************************************************************************
用entmake比command会快不少(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 . "*polyline"))) i 0);选择多线段
(setvar "pdmode" 33) (setvar "osmode" 0)
(setq tx 10000000000000000 ty 10000000000000000);定义临时变量
(setq tmaxx -10000000000000000 tmaxy -10000000000000000);定义临时变量
(setq waiweiw 0 waiweih 0)
(repeat (sslength ss)
(setq ssn (ssname ss i) endata (entget ssn))(setq n 0 xh 1) (terpri)
(repeat (length endata)
(setq pp (nth n endata)key (car pp))
(if (= key 10)
(progn (setq x1 (cadr pp) y1 (caddr pp))
(setq x (rtos x1 2 4) y (rtos y1 2 4))
(setq PP (list x1 y1))
(if (> tx x1 ) (progn (setq tx x1)) )
(if (> ty y1 ) (progn (setq ty y1)) )
(if (< tmaxx x1 ) (progn (setq tmaxx x1)) )
(if (< tmaxy y1 ) (progn (setq tmaxy y1)) )
(setq xh (1+ xh))
)
)
(setq n (1+ n))
)
(setq i (1+ i))
);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)
;(command ".pline" mp1 mp2 mp3 mp4 "c")
(sk_mkline wpa mp1 "细线5" 256)
(sk_mkline wpb mp2 "细线5" 256)
(sk_mkline wpc mp3 "细线5" 256)
(sk_mkline wpd mp4 "细线5" 256)
;(COMMAND "LAYER" "SET" "细线1" "")
(setq cblfx (- blfx 0)) (setq tmp2 (polar mp1 0 cblfx));窗扇槽深
(setq bp1 (polar tmp2 (/ pi 2) cblfx)) (setq bp2 (polar bp1 0 (- (- ww (* 2 csxmian)) (* 2 cblfx))))
(setq bp3 (polar bp2 (/ pi 2) (- (- hh (* 2 csxmian)) (* 2 cblfx)))) (setq bp4 (polar bp3 pi (- (- ww (* 2 csxmian)) (* 2 cblfx))))
(sk_mkpl (list bp1 bp2 bp3 bp4) "细线1" 256 1)
;(COMMAND "LAYER" "SET" "细线5" "")
(setq tmp3 (polar mp1 0 22))
(setq yp1 (polar tmp3 (/ pi 2) 22))
(setq yp2 (polar yp1 0 (- (- ww (* 2 csxmian)) (* 2 22))))
(setq yp3 (polar yp2 (/ pi 2) (- (- hh (* 2 csxmian)) (* 2 22))))
(setq yp4 (polar yp3 pi (- (- ww (* 2 csxmian)) (* 2 22))))
;(command ".pline" yp1 yp2 yp3 yp4 "c")
(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)
(progn
(sk_mkline lin1 lin2 "细线5" 256)
(sk_mkline lin4 lin3 "细线5" 256)
(sk_mkline yp2 yp2 "细线5" 256)
(sk_mkline yp4 yp1 "细线5" 256)
)
(progn
(sk_mkpl (list yp1 yp2 yp3 yp4) "细线5" 256 1)
(sk_mkline yp1 mp1 "细线5" 256)
(sk_mkline yp2 mp2 "细线5" 256)
(sk_mkline yp3 mp3 "细线5" 256)
(sk_mkline yp4 mp4 "细线5" 256)
)
)
(setq zd1 (polar yp1 (/ pi 2) (/(- (- hh (* 2 csxmian)) (* 2 22)) 2)))
(sk_mkpl (list yp3 zd1 yp2) "细线5" 256 0)
;(command ".pline" yp3 zd1 yp2 "")
;(COMMAND "LAYER" "SET" "配件" "")
(setvar "clayer" "配件")
(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" b "1"b1 "1" an "0" ) (setq a2 "czhishou" b "1"b1 "1" an "0" )
(command "insert" a1 peijian1 b b1 an)
(command "insert" a1 peijian2 b b1 an)
(command "insert" a2 peijian3 b b1 an)
(setvar "clayer" "细线5")
;(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 ))
)
)
(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))))
(command ".pline" mp1 mp2 mp3 mp4 "c")
(command ".line" wpa mp1 "" ".line" wpb mp2 "" ".line" wpc mp3 "" ".line" wpd mp4 "")
(command "LAYER" "SET" "细线1" "")
(setq cblfx (- blfx 0))
(setq tmp2 (polar mp1 0 cblfx));窗扇槽深
(setq bp1 (polar tmp2 (/ pi 2) cblfx))
(setq bp2 (polar bp1 0 (- (- ww (* 2 csxmian)) (* 2 cblfx))))
(setq bp3 (polar bp2 (/ pi 2) (- (- hh (* 2 csxmian)) (* 2 cblfx))))
(setq bp4 (polar bp3 pi (- (- ww (* 2 csxmian)) (* 2 cblfx))))
(command ".pline" bp1 bp2 bp3 bp4 "c")
(command "LAYER" "S" "细线5" "")
(setq tmp3 (polar mp1 0 22))
(setq yp1 (polar tmp3 (/ pi 2) 22))
(setq yp2 (polar yp1 0 (- (- ww (* 2 csxmian)) (* 2 22))))
(setq yp3 (polar yp2 (/ pi 2) (- (- hh (* 2 csxmian)) (* 2 22))))
(setq yp4 (polar yp3 pi (- (- ww (* 2 csxmian)) (* 2 22))))
;(command ".pline" yp1 yp2 yp3 yp4 "c")
(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
(command ".pline" yp1 yp2 yp3 yp4 "c")
(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)))
(command ".pline" yp3 zd1 yp2 "")
(command "LAYER" "SET" "配件" "")
(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)
) ZZXXQQ 发表于 2014-1-10 23:04 static/image/common/back.gif
感谢大侠帮忙，现在的代码好多了，另外大侠还想请教一下，可否一次选择多个矩形一次性都生成窗扇呢 jly0406 发表于 2014-1-11 10:43 static/image/common/back.gif
感谢大侠帮忙，现在的代码好多了，另外大侠还想请教一下，可否一次选择多个矩形一次性都生成窗扇呢
将画窗部分放到循环内就可以。 ZZXXQQ 发表于 2014-1-11 20:48 static/image/common/back.gif
将画窗部分放到循环内就可以。
大侠你好，我刚接触lisp，勉强能拼凑些代码用于实践，现在让我编还真是不太行，我现在就会大循环，就是点一个矩形，画个窗扇，点一个矩形画一个窗扇，该怎么加循环能实现一次选好20个矩形或者更多矩形自动都画出窗扇呢 本帖最后由 jly0406 于 2014-1-11 21:56 编辑
将两位大侠的代码结合了一下，该怎么加循环能实现上述所说呢
(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 ))
)
)
页:
[1]