lisp代码 求大侠加一下循环

jly0406

下边的命令能实现点选矩形画窗扇，我是个菜鸟，只会简单拼凑代码，自己加了老是出错 ，请教大侠如何加循环，能实现一次选多个矩形然后都画出窗扇呢，这个对我很重要，感激万分

(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 ))
  )
)

llsheng_73

晕，还要币才能看

蓝图测绘

真有意思，求人解决问题还有收费

jly0406

llsheng_73 发表于 2014-1-11 22:39
晕，还要币才能看

对不起大侠啊，我是个笨蛋，我以为是要付费给你们呢，因为我太需要这个代码了，实在对不起，太对不起……

jly0406

蓝图测绘 发表于 2014-1-11 23:36
真有意思，求人解决问题还有收费

对不起大侠啊，我是个笨蛋，我以为是要付费给你们呢，因为我太需要这个代码了，实在对不起，太对不起……

newbuser

你看懂这个应该就没问题了

(setq i 0)
(repeat  n           ;;循环开始

  (setq i (1+ i))   ;;循环结束
)

蓝图测绘

刚来搞反了是难免的，我也给过鸡蛋，我还以为是奖励呢