本帖最后由 xyp1964 于 2011-10-20 06:30 编辑
- ;; zxys(直线延伸)
- (defun c:zxys (/ ilst ll1 ll2)
- (cmdla0)
- ;; __________________________________________________________________
- (defun main-pro (/ ss i s1)
- (if (setq s0 (car (entsel "\n选择边界线<退出>: ")))
- (progn
- (redraw s0 3)
- (princ "\n选择区域直线: ")
- (setq ss (if (= bo4 "1")
- (ssget (list '(0 . "line") (cons 8 (nth (atoi po1) lst1))))
- (ssget '((0 . "line")))
- )
- )
- (if ss
- (progn
- (setq ptn '() i -1)
- (if (ssmemb s0 ss)
- (ssdel s0 ss)
- )
- (while (setq s1 (ssname ss (setq i (1+ i))))
- (if (not (xyp-get-Inters s0 s1 0))
- (setq pt (car (xyp-get-Inters s1 s0 3))
- ptn (cons pt ptn)
- s1 (xyp-LinePtSub s1 pt)
- )
- (if (and (= bo2 "1")
- (setq ptn1 (xyp-get-Inters s0 s1 0))
- (= (length ptn1) 1)
- )
- (setq s1 (xyp-LinePtSub s1 (car ptn1)))
- )
- )
- )
- (if (and ptn (= bo1 "1") (xyp-etype s0 "LINE"))
- (setq ptn (cdr (xyp-Max-Pt2pt ptn))
- s0 (xyp-SubUpd s0 10 (car ptn))
- s0 (xyp-SubUpd s0 11 (cadr ptn))
- )
- )
- )
- )
- (redraw s0 4)
- )
- )
- )
- ;; __________________________________________________________________
- (defun abo4 ()
- (xyp-Dcl-Gettile '("bo4"))
- (cond ((= bo4 "1") (mode_tile "po1" 0) (mode_tile "k01" 0))
- ((= bo4 "0") (mode_tile "po1" 1) (mode_tile "k01" 1))
- )
- )
- (defun ak01 ()
- (if (setq s1 (car (entsel "\n选择<退出>: ")))
- (setq la (xyp-get-dxf 8 s1)
- po1 (itoa (- (length lst1) (length (member la lst1))))
- )
- )
- (sub)
- )
- ;; __________________________________________________________________
- (setq ll1 '(bo1 po1 bo4 bo2)
- ll2 '("1" "0" "1" "1")
- )
- (defun ajbcs () (xyp-Multiple-Settile ll1 ll2))
- (xyp-initSet ll1 ll2)
- (setq lst1 (xyp-get-layers)
- ilst '(("bo1" "边界延伸" "bool")
- ("bo2" "短边消除" "bool")
- ":row{"
- ("bo4" "图层过滤" "bool" "(abo4)")
- ("po1" "" "poplist" "lst1" "8")
- ("k01" "" "i6" "-15" "2" "xyp1964(szx)" "(ak01)")
- "}"
- "spacer;"
- ("" "" "user""(abo4)")
- ("jbcs" "缺省参数" "button1" "(ajbcs)")
- "spacer;"
- "ioc"
- )
- )
- (if (= (xyp-Dcl-Init Ilst "【直线延伸】" t) 1)
- (main-pro)
- )
- (cmdla1)
- )
|