[求助]：求框选四边形将对角点连线的lsp

sandyhuahua

最近常画平推窗开启符号，需将画矩形的两根对角线，一个一个画过来还是非常费力的，请教各位如何编一个lsp文件，可以框选所有的矩形，可以将所有矩形的对角线都画出来，所画对角线在当前图层。

zxq0220

[php]
;框选四边形对角连线 xdcad zxq0220 2007.12.13
(defun c:tt ()
(defun getpline (ename / pts)
  (setq pts '())
  (mapcar '(lambda(x) (if (= (car x) 10)(setq pts (cons (cdr x) pts)))) (entget ename))
  (reverse pts)
)
(setvar "CMDECHO" 0)
(setq OLDOS (getvar "OSMODE"))
(if (and (princ "\nSelect LWPOLYLINE(s) :")
          (setq SS (ssget '((0 . "LWPOLYLINE") (70 . 1))))) (progn
  (setvar "OSMODE" 0)
  (setq i -1)
  (repeat (sslength ss)
   (setq en (ssname ss (setq i (1+ i))))
   (if (= (cdr (assoc 90 (entget en))) 4) (progn
    (setq ptl (getpline en)
              p1 (car ptl)
                  p2 (caddr ptl)
                  p3 (cadr ptl)
                  p4 (last ptl))
    (command "LINE" P1 P2 "" "LINE" P3 P4 "")
   ))
  )
))
(setvar "OSMODE" OLDOS)
(setvar "CMDECHO" 1)
(princ)
)
[/php]

sandyhuahua

真是太感谢了，以后绘制这样的图，速度可不止翻一倍呀。

zml84

2. 
   
3. ;;;============================================
   
4. (defun C:TT2 (/ PT1 PT2 PT3 PT4)
   
5.     (if        (and (setq PT1 (getpoint "\n第一角点："))
   
6.              (setq PT2 (getcorner PT1 "\n第二角点："))
   
7.         )
   
8.         (progn
   
9.             (setq PT3 (list (car PT1) (cadr PT2))
   
10.                   PT4 (list (car PT2) (cadr PT1))
    
11.             )
    
12.             (setvar "CMDECHO" 0)
    
13.             ;;(command "_rectang" "non" pt1 "non" pt2)
    
14.             ;;(command "_.line" "non" pt1 "non" pt2 "")
    
15.             ;;(command "_.line" "non" pt3 "non" pt4 "")
    
16.             (command "_.pline"             "non"   PT1     "non"   PT3
    
17.                      "non"   PT4     "non"   PT2     "non"   PT1
    
18.                      "non"   PT4     "non"   PT2     "non"   PT3
    
19.                      ""
    
20.                     )
    
21.             (setvar "CMDECHO" 1)
    
22.         )
    
23.     )
    
24.     (princ)
    
25. )
    

<br /> ;;;============================================<br /> (defun C:TT2 (/ PT1 PT2 PT3 PT4)<br />     (if        (and (setq PT1 (getpoint "\n第一角点："))<br />              (setq PT2 (getcorner PT1 "\n第二角点："))<br />         )<br />         (progn<br />             (setq PT3 (list (car PT1) (cadr PT2))<br />                   PT4 (list (car PT2) (cadr PT1))<br />             )<br />             (setvar "CMDECHO" 0)<br />             ;;(command "_rectang" "non" pt1 "non" pt2)<br />             ;;(command "_.line" "non" pt1 "non" pt2 "")<br />             ;;(command "_.line" "non" pt3 "non" pt4 "")<br />             (command "_.pline"             "non"   PT1     "non"   PT3<br />                      "non"   PT4     "non"   PT2     "non"   PT1<br />                      "non"   PT4     "non"   PT2     "non"   PT3<br />                      ""<br />                     )<br />             (setvar "CMDECHO" 1)<br />         )<br />     )<br />     (princ)<br /> )<br />

carrot1983

http://www.xdcad.net/forum/showthread.php?s=&threadid=645275
这个可能会帮到你。。。
修改了一下就是下面的啦
[php]
;;;通用函数 carrot1983.2007-12-15
(vl-load-com)
;;ss->elst选择集->图元表
(defun ss->elst        (ss / elst)
  (setq i 0)
  (repeat (sslength ss)
    (setq elst (cons (ssname ss i) elst)
          i    (1+ i)
    )
  )
  (reverse elst)
)

;;;按顺序取得曲线的点
(defun jw-get-plst (E / I O PLST)
  (setq        o    (vlax-ename->vla-object e)
        i    1
        plst nil
  )
  (repeat 100
    (if        (and o (setq p (vlax-curve-getPointAtParam o i)))
      (setq plst (cons p plst)
            i         (1+ i)
      )
      (setq o nil)
    )
  )
  plst
)

;;;写线jw-make-line
(defun jw-make-line (v10 v11 cla)
  (entmake (list (cons 0 "LINE")
                 (cons 6 "BYLAYER")
                 (cons 8 cla)
                 (cons 10 v10)
                 (cons 11 v11)
                 (cons 39 0.0)
                 (cons 62 256)
                 (cons 210 (list 0.0 0.0 1.0))
           )
  )
)


;;;主程序：tt画矩形对角线carrot1983.2007-12-15
(defun c:tt (/ CLA ELST PLST SS)
  (setq cla (getvar "clayer"))
  (if (setq ss (ssget '((0 . "*POLYLINE"))))
    (progn
      (setq elst (ss->elst ss))
      (foreach e elst
        (setq plst (jw-get-plst e))
        (jw-make-line (nth 0 plst) (nth 2 plst) cla)
        (jw-make-line (nth 1 plst) (nth 3 plst) cla)
      )
    )
    (alert "\n请重新选择!")
  )
  (princ)
)
[/php]

万俊波

非常感谢，正好目前要画一批四边形玻璃的加工图，实在帮了大忙了。