根据不同的区域大小插入不同的块

citykunan

这次又要麻烦飞版主了，上次你帮我解决的那个根据两个交点间距不同，插入不同的块，十分好用。这次我遇到了一个新的情况。你可以看看这张图。它是希望能够，根据不同的区域大小，插入不同的块，我想了很久也没什么好办法，你能帮助一下吗？
再次谢谢。

citykunan

我做了一个可以点选的，要和1搂的图配合用，可能也只能这样了。
各位版主，有好办法可以实现复选，请跟帖告知，谢谢。

龙龙仔

2. 
   
3. ;;有是有,只是要先框選到要插入圖塊的圍範,不夠完整
   
4. ;;BY 龍龍仔(LUCAS)
   
5. ;;-------------------------------------------------------------
   
6. (defun GETINTERPOINTS (ENT2 / E2 PT3 PT4)
   
7.   (setq E2 (entget ENT2))
   
8.   (setq PT3 (cdr (assoc 10 E2)))
   
9.   (setq PT4 (cdr (assoc 11 E2)))
   
10.   (inters PT1 PT2 PT3 PT4)
    
11. )
    
12. (defun GETALLINTERS (SS / N I J ENT1 POINTS POINT S1 PT1 PT2)
    
13.   (setq        N      (sslength SS)
    
14.         POINTS '()
    
15.   )
    
16.   (setq I 0)
    
17.   (repeat N
    
18.     (setq ENT1 (ssname SS I))
    
19.     (setq PT1 (cdr (assoc 10 (entget ENT1))))
    
20.     (setq PT2 (cdr (assoc 11 (entget ENT1))))
    
21.     (setq S1 (ssget "F" (list PT1 PT2)))
    
22.     (setq J 0)
    
23.     (repeat (sslength S1)
    
24.       (if (and (setq POINT (GETINTERPOINTS (ssname S1 J)))
    
25.                (not (member POINT POINTS))
    
26.           )
    
27.         (setq POINTS (append POINTS (list POINT)))
    
28.       )
    
29.       (setq J (1+ J))
    
30.     )
    
31.     (setq I (1+ I))
    
32.   )
    
33.   POINTS
    
34. )
    
35. 
    
36. (defun C:TTT (/ OS CMD SS PT_LIST)
    
37.   (setq OS (getvar "osmode"))
    
38.   (setq CMD (getvar "cmdecho"))
    
39.   (setq SS (ssget '((0 . "LINE"))))
    
40.   (command "_.undo" "be")
    
41.   (setvar "osmode" 0)
    
42.   (setvar "cmdecho" 0)
    
43.   (setq PT_LIST (GETALLINTERS SS))
    
44.   (setq
    
45.     PT_LIST
    
46.      (vl-sort PT_LIST
    
47.               (function
    
48.                 (lambda        (P1 P2)
    
49.                   (cond        ((< (cadr P1) (cadr P2)) t)
    
50.                         ((and (= (cadr P1) (cadr P2))
    
51.                               (< (car P1) (car P2))
    
52.                          )
    
53.                          t
    
54.                         )
    
55.                         (t NIL)
    
56.                   )
    
57.                 )
    
58.               )
    
59.      )
    
60.   )
    
61.   (foreach ENT1        PT_LIST
    
62.     (setq ENT (list (+ (car ENT1) 10) (+ (cadr ENT1) 10) 0.0))
    
63.     (setq EN (entlast))
    
64.     ;;---這步很未寫好,改善中
    
65.     (command "_.boundary"
    
66.              (mapcar '(lambda (X Y) (/ (+ X Y) 2.0))
    
67.                      (polar ENT1 0.0 200.0)
    
68.                      (polar ENT1 (* 0.5 pi) 300.0)
    
69.              )
    
70.              ""
    
71.     )
    
72.     ;;--
    
73.     (setq EN1 (entlast))
    
74.     (setq SS (ssget "C"
    
75.                     (list (+ (car ENT) 1180) (+ (cadr ENT) 1180) 0.0)
    
76.                     ENT
    
77.                     '((0 . "INSERT,LINE"))
    
78.              )
    
79.     )
    
80.     (setq SS1 (ssget "C"
    
81.                      ENT
    
82.                      (list (+ (car ENT) 1180) (+ (cadr ENT) 580) 0.0)
    
83.                      '((0 . "INSERT,LINE"))
    
84.               )
    
85.     )
    
86.     (setq SS2 (ssget "C"
    
87.                      ENT
    
88.                      (list (+ (car ENT) 580) (+ (cadr ENT) 580) 0.0)
    
89.                      '((0 . "INSERT,LINE"))
    
90.               )
    
91.     )
    
92.     (cond
    
93.       ((and (not SS) (not (equal EN (entlast))))
    
94.        (command "_.insert" "1100x1100" ENT1 "" "" "")
    
95.        (command "_.erase" EN1 "")
    
96.       )
    
97.       ((and (not SS1) (not (equal EN (entlast))))
    
98.        (command "_.insert" "1100x500" ENT1 "" "" "")
    
99.        (command "_.erase" EN1 "")
    
100.       )
     
101.       ((and (not SS2) (not (equal EN (entlast))))
     
102.        (command "_.insert" "500x500" ENT1 "" "" "")
     
103.        (command "_.erase" EN1 "")
     
104.       )
     
105.     )
     
106.   )
     
107.   (command "_.undo" "e")
     
108.   (setvar "osmode" OS)
     
109.   (setvar "cmdecho" CMD)
     
110. )
     
111. ;;-------------------------------------------------------------
     

<br /> ;;有是有,只是要先框選到要插入圖塊的圍範,不夠完整<br /> ;;BY 龍龍仔(LUCAS)<br /> ;;-------------------------------------------------------------<br /> (defun GETINTERPOINTS (ENT2 / E2 PT3 PT4)<br />   (setq E2 (entget ENT2))<br />   (setq PT3 (cdr (assoc 10 E2)))<br />   (setq PT4 (cdr (assoc 11 E2)))<br />   (inters PT1 PT2 PT3 PT4)<br /> )<br /> (defun GETALLINTERS (SS / N I J ENT1 POINTS POINT S1 PT1 PT2)<br />   (setq        N      (sslength SS)<br />         POINTS '()<br />   )<br />   (setq I 0)<br />   (repeat N<br />     (setq ENT1 (ssname SS I))<br />     (setq PT1 (cdr (assoc 10 (entget ENT1))))<br />     (setq PT2 (cdr (assoc 11 (entget ENT1))))<br />     (setq S1 (ssget "F" (list PT1 PT2)))<br />     (setq J 0)<br />     (repeat (sslength S1)<br />       (if (and (setq POINT (GETINTERPOINTS (ssname S1 J)))<br />                (not (member POINT POINTS))<br />           )<br />         (setq POINTS (append POINTS (list POINT)))<br />       )<br />       (setq J (1+ J))<br />     )<br />     (setq I (1+ I))<br />   )<br />   POINTS<br /> )<br /> <br /> (defun C:TTT (/ OS CMD SS PT_LIST)<br />   (setq OS (getvar "osmode"))<br />   (setq CMD (getvar "cmdecho"))<br />   (setq SS (ssget '((0 . "LINE"))))<br />   (command "_.undo" "be")<br />   (setvar "osmode" 0)<br />   (setvar "cmdecho" 0)<br />   (setq PT_LIST (GETALLINTERS SS))<br />   (setq<br />     PT_LIST<br />      (vl-sort PT_LIST<br />               (function<br />                 (lambda        (P1 P2)<br />                   (cond        ((< (cadr P1) (cadr P2)) t)<br />                         ((and (= (cadr P1) (cadr P2))<br />                               (< (car P1) (car P2))<br />                          )<br />                          t<br />                         )<br />                         (t NIL)<br />                   )<br />                 )<br />               )<br />      )<br />   )<br />   (foreach ENT1        PT_LIST<br />     (setq ENT (list (+ (car ENT1) 10) (+ (cadr ENT1) 10) 0.0))<br />     (setq EN (entlast))<br />     ;;---這步很未寫好,改善中<br />     (command "_.boundary"<br />              (mapcar '(lambda (X Y) (/ (+ X Y) 2.0))<br />                      (polar ENT1 0.0 200.0)<br />                      (polar ENT1 (* 0.5 pi) 300.0)<br />              )<br />              ""<br />     )<br />     ;;--<br />     (setq EN1 (entlast))<br />     (setq SS (ssget "C"<br />                     (list (+ (car ENT) 1180) (+ (cadr ENT) 1180) 0.0)<br />                     ENT<br />                     '((0 . "INSERT,LINE"))<br />              )<br />     )<br />     (setq SS1 (ssget "C"<br />                      ENT<br />                      (list (+ (car ENT) 1180) (+ (cadr ENT) 580) 0.0)<br />                      '((0 . "INSERT,LINE"))<br />               )<br />     )<br />     (setq SS2 (ssget "C"<br />                      ENT<br />                      (list (+ (car ENT) 580) (+ (cadr ENT) 580) 0.0)<br />                      '((0 . "INSERT,LINE"))<br />               )<br />     )<br />     (cond<br />       ((and (not SS) (not (equal EN (entlast))))<br />        (command "_.insert" "1100x1100" ENT1 "" "" "")<br />        (command "_.erase" EN1 "")<br />       )<br />       ((and (not SS1) (not (equal EN (entlast))))<br />        (command "_.insert" "1100x500" ENT1 "" "" "")<br />        (command "_.erase" EN1 "")<br />       )<br />       ((and (not SS2) (not (equal EN (entlast))))<br />        (command "_.insert" "500x500" ENT1 "" "" "")<br />        (command "_.erase" EN1 "")<br />       )<br />     )<br />   )<br />   (command "_.undo" "e")<br />   (setvar "osmode" OS)<br />   (setvar "cmdecho" CMD)<br /> )<br /> ;;-------------------------------------------------------------<br />

无痕

已知条件是什么？是那个线框，还是交点？

龙龙仔

2. 
   
3. ;;發現用inters交點精度不太好
   
4. ;;BY 龍龍仔(LUCAS)
   
5. ;;要先框選到要插入圖塊的圍範,不夠完整
   
6. ;;-----------------------------------------------
   
7. ;; CDNC5-02.LSP
   
8. ;; Bill Kramer
   
9. ;; Find all intersections between objects in
   
10. ;; the selection set SS.
    
11. ;; Process - Create drawing with intersecting lines and lwpolylines.
    
12. ;;           Load function set
    
13. ;;           Run command function INTLINES
    
14. ;;           Intersections are marked with POINT objects on current layer
    
15. (defun INTLINES        (/ SSL                        ;length of SS
    
16.                  PTS                        ;returning list
    
17.                  AOBJ1                        ;Object 1
    
18.                  AOBJ2                        ;Object 2
    
19.                  N1                        ;Loop counter
    
20.                  N2                        ;Loop counter
    
21.                  IPTS                        ;intersects
    
22.                  A N NN        HOLDOSMODE)
    
23.   (vl-load-com)
    
24.   (command "_.UNDO" "_GROUP")
    
25.   (setq HOLDOSMODE (getvar "OSMODE"))
    
26.   (setvar "OSMODE" 0)
    
27.   (setq SS (ssget '((0 . "*LINE,ARC,CIRCLE,ELLIPSE"))))
    
28.   (setq        N1  0                                ;index for outer loop
    
29.         SSL (sslength SS)
    
30.   )                                        ; Outer loop, first through second to last
    
31.   (while (< N1 (1- SSL))                ; Get object 1, convert to VLA object type
    
32.     (setq AOBJ1        (ssname SS N1)
    
33.           AOBJ1        (vlax-ename->vla-object AOBJ1)
    
34.           N2        (1+ N1)
    
35.     )                                        ;index for inner loop
    
36. ;;; Inner loop, go through remaining objects
    
37.     (while (< N2 SSL)                        ; Get object 2, convert to VLA object
    
38.       (setq AOBJ2 (ssname SS N2)
    
39.             AOBJ2 (vlax-ename->vla-object AOBJ2)
    
40. ;;;Find intersections of Objects
    
41.             IPTS  (vla-intersectwith
    
42.                     AOBJ1
    
43.                     AOBJ2
    
44.                     0
    
45.                   )                        ; variant result
    
46.             IPTS  (vlax-variant-value IPTS)
    
47.       )
    
48. ;;;Variant array has values?
    
49.       (if (> (vlax-safearray-get-u-bound IPTS 1) 0)
    
50.         (progn                                ;array holds values, convert it
    
51.           (setq        IPTS                        ;to a list.
    
52.                  (vlax-safearray->list IPTS)
    
53.           )
    
54. ;;;Loop through list constructing points
    
55.           (while (> (length IPTS) 0)
    
56.             (setq PTS  (cons (list (car IPTS)
    
57.                                    (cadr IPTS)
    
58.                                    (caddr IPTS)
    
59.                              )
    
60.                              PTS
    
61.                        )
    
62.                   IPTS (cdddr IPTS)
    
63.             )
    
64.           )
    
65.         )
    
66.       )
    
67.       (setq N2 (1+ N2))
    
68.     )                                        ;inner loop end
    
69.     (setq N1 (1+ N1))
    
70.   )                                        ;outer loop end
    
71.   (setvar "OSMODE" HOLDOSMODE)
    
72.   (command "_.UNDO" "_END")
    
73.   PTS
    
74. )
    
75. 
    
76. (defun C:TTT (/ OS CMD SS PT_LIST EN ENT1 EN1 ENT ARE)
    
77.   (setq PT_LIST (INTLINES))
    
78.   (setq CMD (getvar "cmdecho"))
    
79.   (setvar "cmdecho" 0)
    
80.   (command "_.undo" "be")
    
81.   (setq OS (getvar "osmode"))
    
82.   (setvar "osmode" 0)
    
83.   (setq
    
84.     PT_LIST
    
85.      (vl-sort PT_LIST
    
86.               (function
    
87.                 (lambda        (P1 P2)
    
88.                   (cond        ((< (cadr P1) (cadr P2)) t)
    
89.                         ((and (equal (cadr P1) (cadr P2) 0.00001)
    
90.                               (< (car P1) (car P2))
    
91.                          )
    
92.                          t
    
93.                         )
    
94.                         (t NIL)
    
95.                   )
    
96.                 )
    
97.               )
    
98.      )
    
99.   )
    
100.   (foreach ENT1        PT_LIST
     
101.     (setq ENT (list (+ (car ENT1) 300.0) (+ (cadr ENT1) 300.0) 0.0))
     
102.     (setq EN (entlast))
     
103.     (vl-cmdf "_.boundary" ENT "")
     
104.     (setq EN1 (entlast))
     
105.     (if        (not (equal EN EN1))
     
106.       (progn
     
107.         (setq ARE (vla-get-area (vlax-ename->vla-object EN1)))
     
108.         (cond
     
109.           ((equal ARE (* 1200.0 1200.0) 0.001)
     
110.            (vl-cmdf "_.insert" "1100x1100" ENT1 "" "" "")
     
111.           )
     
112.           ((equal ARE (* 1200.0 600.0) 0.001)
     
113.            (vl-cmdf "_.insert" "1100x500" ENT1 "" "" "")
     
114.           )
     
115.           ((equal ARE (* 600.0 600.0) 0.001)
     
116.            (vl-cmdf "_.insert" "500x500" ENT1 "" "" "")
     
117.           )
     
118.         )
     
119.         (command "_.erase" EN1 "")
     
120.       )
     
121.     )
     
122.   )
     
123.   (setvar "osmode" OS)
     
124.   (command "_.undo" "e")
     
125.   (setvar "cmdecho" CMD)
     
126.   (princ)
     
127. )
     
128. ;;-------------------------------------------------------------
     

<br /> ;;發現用inters交點精度不太好<br /> ;;BY 龍龍仔(LUCAS)<br /> ;;要先框選到要插入圖塊的圍範,不夠完整<br /> ;;-----------------------------------------------<br /> ;; CDNC5-02.LSP<br /> ;; Bill Kramer<br /> ;; Find all intersections between objects in<br /> ;; the selection set SS.<br /> ;; Process - Create drawing with intersecting lines and lwpolylines.<br /> ;;           Load function set<br /> ;;           Run command function INTLINES<br /> ;;           Intersections are marked with POINT objects on current layer<br /> (defun INTLINES        (/ SSL                        ;length of SS<br />                  PTS                        ;returning list<br />                  AOBJ1                        ;Object 1<br />                  AOBJ2                        ;Object 2<br />                  N1                        ;Loop counter<br />                  N2                        ;Loop counter<br />                  IPTS                        ;intersects<br />                  A N NN        HOLDOSMODE)<br />   (vl-load-com)<br />   (command "_.UNDO" "_GROUP")<br />   (setq HOLDOSMODE (getvar "OSMODE"))<br />   (setvar "OSMODE" 0)<br />   (setq SS (ssget '((0 . "*LINE,ARC,CIRCLE,ELLIPSE"))))<br />   (setq        N1  0                                ;index for outer loop<br />         SSL (sslength SS)<br />   )                                        ; Outer loop, first through second to last<br />   (while (< N1 (1- SSL))                ; Get object 1, convert to VLA object type<br />     (setq AOBJ1        (ssname SS N1)<br />           AOBJ1        (vlax-ename->vla-object AOBJ1)<br />           N2        (1+ N1)<br />     )                                        ;index for inner loop<br /> ;;; Inner loop, go through remaining objects<br />     (while (< N2 SSL)                        ; Get object 2, convert to VLA object<br />       (setq AOBJ2 (ssname SS N2)<br />             AOBJ2 (vlax-ename->vla-object AOBJ2)<br /> ;;;Find intersections of Objects<br />             IPTS  (vla-intersectwith<br />                     AOBJ1<br />                     AOBJ2<br />                     0<br />                   )                        ; variant result<br />             IPTS  (vlax-variant-value IPTS)<br />       )<br /> ;;;Variant array has values?<br />       (if (> (vlax-safearray-get-u-bound IPTS 1) 0)<br />         (progn                                ;array holds values, convert it<br />           (setq        IPTS                        ;to a list.<br />                  (vlax-safearray->list IPTS)<br />           )<br /> ;;;Loop through list constructing points<br />           (while (> (length IPTS) 0)<br />             (setq PTS  (cons (list (car IPTS)<br />                                    (cadr IPTS)<br />                                    (caddr IPTS)<br />                              )<br />                              PTS<br />                        )<br />                   IPTS (cdddr IPTS)<br />             )<br />           )<br />         )<br />       )<br />       (setq N2 (1+ N2))<br />     )                                        ;inner loop end<br />     (setq N1 (1+ N1))<br />   )                                        ;outer loop end<br />   (setvar "OSMODE" HOLDOSMODE)<br />   (command "_.UNDO" "_END")<br />   PTS<br /> )<br /> <br /> (defun C:TTT (/ OS CMD SS PT_LIST EN ENT1 EN1 ENT ARE)<br />   (setq PT_LIST (INTLINES))<br />   (setq CMD (getvar "cmdecho"))<br />   (setvar "cmdecho" 0)<br />   (command "_.undo" "be")<br />   (setq OS (getvar "osmode"))<br />   (setvar "osmode" 0)<br />   (setq<br />     PT_LIST<br />      (vl-sort PT_LIST<br />               (function<br />                 (lambda        (P1 P2)<br />                   (cond        ((< (cadr P1) (cadr P2)) t)<br />                         ((and (equal (cadr P1) (cadr P2) 0.00001)<br />                               (< (car P1) (car P2))<br />                          )<br />                          t<br />                         )<br />                         (t NIL)<br />                   )<br />                 )<br />               )<br />      )<br />   )<br />   (foreach ENT1        PT_LIST<br />     (setq ENT (list (+ (car ENT1) 300.0) (+ (cadr ENT1) 300.0) 0.0))<br />     (setq EN (entlast))<br />     (vl-cmdf "_.boundary" ENT "")<br />     (setq EN1 (entlast))<br />     (if        (not (equal EN EN1))<br />       (progn<br />         (setq ARE (vla-get-area (vlax-ename->vla-object EN1)))<br />         (cond<br />           ((equal ARE (* 1200.0 1200.0) 0.001)<br />            (vl-cmdf "_.insert" "1100x1100" ENT1 "" "" "")<br />           )<br />           ((equal ARE (* 1200.0 600.0) 0.001)<br />            (vl-cmdf "_.insert" "1100x500" ENT1 "" "" "")<br />           )<br />           ((equal ARE (* 600.0 600.0) 0.001)<br />            (vl-cmdf "_.insert" "500x500" ENT1 "" "" "")<br />           )<br />         )<br />         (command "_.erase" EN1 "")<br />       )<br />     )<br />   )<br />   (setvar "osmode" OS)<br />   (command "_.undo" "e")<br />   (setvar "cmdecho" CMD)<br />   (princ)<br /> )<br /> ;;-------------------------------------------------------------<br />

2樓的程序不用那麼長

;;BY 龍龍仔(LUCAS)
(defun C:TT (/ CMD OS PT1 EN EN1 ARE ENT1)
  (defun AX:GETBOUNDINGBOX (ENT / LL UR)
    (vla-getboundingbox (vlax-ename->vla-object ENT) 'LL 'UR)
    (mapcar 'vlax-safearray->list (list LL UR))
  )
  (setq CMD (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (command "_.undo" "be")
  (setq OS (getvar "osmode"))
  (setvar "osmode" 0)
  (while (setq PT1 (getpoint "\n指定內部點: "))
    (setq EN (entlast))
    (vl-cmdf "_.boundary" PT1 "")
    (setq EN1 (entlast))
    (if        (not (equal EN EN1))
      (progn
        (setq ARE (vla-get-area (vlax-ename->vla-object EN1)))
        (setq ENT1 (car (AX:GETBOUNDINGBOX EN1)))
        (cond
          ((equal ARE (* 1200.0 1200.0) 0.001)
           (vl-cmdf "_.insert" "1100x1100" ENT1 "" "" "")
          )
          ((equal ARE (* 1200.0 600.0) 0.001)
           (vl-cmdf "_.insert" "1100x500" ENT1 "" "" "")
          )
          ((equal ARE (* 600.0 600.0) 0.001)
           (vl-cmdf "_.insert" "500x500" ENT1 "" "" "")
          )
        )
        (command "_.erase" EN1 "")
      )
    )
  )
  (setvar "osmode" OS)
  (command "_.undo" "e")
  (setvar "cmdecho" CMD)
  (princ)
)

citykunan

谢谢龙版主帮我改程序。

对于龙版主那个框选的程序我有点看不懂，我现在想多增加两个功能不知行不行？
1.能不能判断框中有东西就不要插块？
2.能不能自动实现，实际插的是同一个块，只是方向旋转90度。因为在同一张图中，长方形的
   块，可能是横放，也有可能是竖放。
详见附件。

万分感谢，若能实现，龙版主可帮了我一大忙了。

龙龙仔

2. 
   
3. ;;BY 龍龍仔(LUCAS)
   
4. ;;要先框選到要插入圖塊的圍範,不夠完整
   
5. ;;-----------------------------------------------
   
6. ;;(setq SS (ssget '((0 . "*LINE") (8 . "right"))));;注意:選線的條件
   
7. 
   
8. 1.能不能判斷框中有東西就不要插塊？(修正完成)
   
9. 
   
10. (defun AX:GETBOUNDINGBOX (ENT / LL UR)
    
11.   (vla-getboundingbox (vlax-ename->vla-object ENT) 'LL 'UR)
    
12.   (mapcar 'vlax-safearray->list (list LL UR))
    
13. )
    
14. 
    
15. ;; CDNC5-02.LSP
    
16. ;; Bill Kramer
    
17. ;; Find all intersections between objects in
    
18. ;; the selection set SS.
    
19. ;; Process - Create drawing with intersecting lines and lwpolylines.
    
20. ;;           Load function set
    
21. ;;           Run vl-cmdf function INTLINES
    
22. ;;           Intersections are marked with POINT objects on current layer
    
23. (defun INTLINES        (/ SSL                        ;length of SS
    
24.                  PTS                        ;returning list
    
25.                  AOBJ1                        ;Object 1
    
26.                  AOBJ2                        ;Object 2
    
27.                  N1                        ;Loop counter
    
28.                  N2                        ;Loop counter
    
29.                  IPTS                        ;intersects
    
30.                  A N NN        HOLDOSMODE)
    
31.   (vl-load-com)
    
32.   (vl-cmdf "_.UNDO" "_GROUP")
    
33.   (setq HOLDOSMODE (getvar "OSMODE"))
    
34.   (setvar "OSMODE" 0)
    
35.   (setq SS (ssget '((0 . "*LINE") (8 . "right"))))
    
36.   ;;注意:選線的條件
    
37.   (setq        N1  0                                ;index for outer loop
    
38.         SSL (sslength SS)
    
39.   )                                        ; Outer loop, first through second to last
    
40.   (while (< N1 (1- SSL))                ; Get object 1, convert to VLA object type
    
41.     (setq AOBJ1        (ssname SS N1)
    
42.           AOBJ1        (vlax-ename->vla-object AOBJ1)
    
43.           N2        (1+ N1)
    
44.     )                                        ;index for inner loop
    
45. ;;; Inner loop, go through remaining objects
    
46.     (while (< N2 SSL)                        ; Get object 2, convert to VLA object
    
47.       (setq AOBJ2 (ssname SS N2)
    
48.             AOBJ2 (vlax-ename->vla-object AOBJ2)
    
49. ;;;Find intersections of Objects
    
50.             IPTS  (vla-intersectwith
    
51.                     AOBJ1
    
52.                     AOBJ2
    
53.                     0
    
54.                   )                        ; variant result
    
55.             IPTS  (vlax-variant-value IPTS)
    
56.       )
    
57. ;;;Variant array has values?
    
58.       (if (> (vlax-safearray-get-u-bound IPTS 1) 0)
    
59.         (progn                                ;array holds values, convert it
    
60.           (setq        IPTS                        ;to a list.
    
61.                  (vlax-safearray->list IPTS)
    
62.           )
    
63. ;;;Loop through list constructing points
    
64.           (while (> (length IPTS) 0)
    
65.             (setq PTS  (cons (list (car IPTS)
    
66.                                    (cadr IPTS)
    
67.                                    (caddr IPTS)
    
68.                              )
    
69.                              PTS
    
70.                        )
    
71.                   IPTS (cdddr IPTS)
    
72.             )
    
73.           )
    
74.         )
    
75.       )
    
76.       (setq N2 (1+ N2))
    
77.     )                                        ;inner loop end
    
78.     (setq N1 (1+ N1))
    
79.   )                                        ;outer loop end
    
80.   (setvar "OSMODE" HOLDOSMODE)
    
81.   (vl-cmdf "_.UNDO" "_END")
    
82.   PTS
    
83. )
    
84. 
    
85. (defun C:TTT (/        OS CMD SS PT_LISTMAXY MAXX EN ENT1 EN1 EN2 ENT ARE)
    
86.                                        
    
87.   (defun SS1 (A B)
    
88.     (ssget "C"
    
89.            ENT1
    
90.            (list (+ (car ENT1) A) (+ (cadr ENT1) B))
    
91.            '((-4 . "<NOT")
    
92.              (-4 . "<OR")
    
93.              (8 . "right")
    
94.              (0 . "DIMENSION")
    
95.              (-4 . "OR>")
    
96.              (-4 . "NOT>")
    
97.             )
    
98.     )
    
99.   )
    
100. 
     
101.   (setq PT_LIST (INTLINES))
     
102.   (setq CMD (getvar "cmdecho"))
     
103.   (setvar "cmdecho" 0)
     
104.   (vl-cmdf "_.undo" "be")
     
105.   (setq OS (getvar "osmode"))
     
106.   (setvar "osmode" 0)
     
107.   (setq
     
108.     PT_LIST
     
109.      (vl-sort
     
110.        PT_LIST
     
111.        (function
     
112.          (lambda (P1 P2)
     
113.            (cond
     
114.              ((< (atof (rtos (cadr P1) 2 5)) (atof (rtos (cadr P2) 2 5)))
     
115.               t
     
116.              )
     
117.              ((and
     
118.                 (equal (rtos (cadr P1) 2 5) (rtos (cadr P2) 2 5))
     
119.                 (< (atof (rtos (car P1) 2 5)) (atof (rtos (car P2) 2 5)))
     
120.               )
     
121.               t
     
122.              )
     
123.            )
     
124.          )
     
125.        )
     
126.      )
     
127.   )
     
128. 
     
129.   (foreach ENT1        PT_LIST
     
130.     ;;(300.0)數值在測試中
     
131.     (setq ENT (list (+ (car ENT1) 300.0) (+ (cadr ENT1) 300.0) 0.0))
     
132.     (setq EN (entlast))
     
133.     (vl-cmdf "_.boundary" ENT "")
     
134.     (setq EN1 (entlast))
     
135.     (if        (not (equal EN EN1))
     
136.       (progn
     
137.         (setq ARE (vla-get-area (vlax-ename->vla-object EN1)))
     
138.         (cond
     
139.           ((equal ARE (* 1200.0 1200.0) 0.001)
     
140.            (if (= (sslength (SS1 1200 1200)) 1)
     
141.              (vl-cmdf "_.insert" "1100x1100" ENT1 "" "" "")
     
142.            )
     
143.           )
     
144.           ((equal ARE (* 1200.0 600.0) 0.001)
     
145.            (setq EN2 (AX:GETBOUNDINGBOX EN1))
     
146.            (if (equal (- (cadadr EN2) (cadar EN2)) 1200 0.001)
     
147.              (if (= (sslength (SS1 600 1200)) 1)
     
148.                (progn
     
149.                  (vl-cmdf "_.insert" "1100x500" ENT1 "" "" "90")
     
150.                  (vl-cmdf "_.mirror"
     
151.                           (entlast)
     
152.                           ""
     
153.                           ENT1
     
154.                           (list (car ENT1) (+ 1 (cadr ENT1)))
     
155.                           "y"
     
156.                  )
     
157.                )
     
158.                ;;(vl-cmdf "_.move" (entlast) "" "0,0" "600,0")
     
159.              )
     
160.              (if (= (sslength (SS1 1200 600)) 1)
     
161.                (vl-cmdf "_.insert" "1100x500" ENT1 "" "" "")
     
162.              )
     
163.            )
     
164.           )
     
165.           ((equal ARE (* 600.0 600.0) 0.001)
     
166.            (if (= (sslength (SS1 600 600)) 1)
     
167.              (vl-cmdf "_.insert" "500x500" ENT1 "" "" "")
     
168.            )
     
169.           )
     
170.         )
     
171.         (vl-cmdf "_.erase" EN1 "")
     
172.       )
     
173.     )
     
174.   )
     
175.   (setvar "osmode" OS)
     
176.   (vl-cmdf "_.undo" "e")
     
177.   (setvar "cmdecho" CMD)
     
178.   (princ)
     
179. )
     
180. ;;-----------------------------
     

<br /> ;;BY 龍龍仔(LUCAS)<br /> ;;要先框選到要插入圖塊的圍範,不夠完整<br /> ;;-----------------------------------------------<br /> ;;(setq SS (ssget '((0 . "*LINE") (8 . "right"))));;注意:選線的條件<br /> <br /> 1.能不能判斷框中有東西就不要插塊？(修正完成)<br /> <br /> (defun AX:GETBOUNDINGBOX (ENT / LL UR)<br />   (vla-getboundingbox (vlax-ename->vla-object ENT) 'LL 'UR)<br />   (mapcar 'vlax-safearray->list (list LL UR))<br /> )<br /> <br /> ;; CDNC5-02.LSP<br /> ;; Bill Kramer<br /> ;; Find all intersections between objects in<br /> ;; the selection set SS.<br /> ;; Process - Create drawing with intersecting lines and lwpolylines.<br /> ;;           Load function set<br /> ;;           Run vl-cmdf function INTLINES<br /> ;;           Intersections are marked with POINT objects on current layer<br /> (defun INTLINES        (/ SSL                        ;length of SS<br />                  PTS                        ;returning list<br />                  AOBJ1                        ;Object 1<br />                  AOBJ2                        ;Object 2<br />                  N1                        ;Loop counter<br />                  N2                        ;Loop counter<br />                  IPTS                        ;intersects<br />                  A N NN        HOLDOSMODE)<br />   (vl-load-com)<br />   (vl-cmdf "_.UNDO" "_GROUP")<br />   (setq HOLDOSMODE (getvar "OSMODE"))<br />   (setvar "OSMODE" 0)<br />   (setq SS (ssget '((0 . "*LINE") (8 . "right"))))<br />   ;;注意:選線的條件<br />   (setq        N1  0                                ;index for outer loop<br />         SSL (sslength SS)<br />   )                                        ; Outer loop, first through second to last<br />   (while (< N1 (1- SSL))                ; Get object 1, convert to VLA object type<br />     (setq AOBJ1        (ssname SS N1)<br />           AOBJ1        (vlax-ename->vla-object AOBJ1)<br />           N2        (1+ N1)<br />     )                                        ;index for inner loop<br /> ;;; Inner loop, go through remaining objects<br />     (while (< N2 SSL)                        ; Get object 2, convert to VLA object<br />       (setq AOBJ2 (ssname SS N2)<br />             AOBJ2 (vlax-ename->vla-object AOBJ2)<br /> ;;;Find intersections of Objects<br />             IPTS  (vla-intersectwith<br />                     AOBJ1<br />                     AOBJ2<br />                     0<br />                   )                        ; variant result<br />             IPTS  (vlax-variant-value IPTS)<br />       )<br /> ;;;Variant array has values?<br />       (if (> (vlax-safearray-get-u-bound IPTS 1) 0)<br />         (progn                                ;array holds values, convert it<br />           (setq        IPTS                        ;to a list.<br />                  (vlax-safearray->list IPTS)<br />           )<br /> ;;;Loop through list constructing points<br />           (while (> (length IPTS) 0)<br />             (setq PTS  (cons (list (car IPTS)<br />                                    (cadr IPTS)<br />                                    (caddr IPTS)<br />                              )<br />                              PTS<br />                        )<br />                   IPTS (cdddr IPTS)<br />             )<br />           )<br />         )<br />       )<br />       (setq N2 (1+ N2))<br />     )                                        ;inner loop end<br />     (setq N1 (1+ N1))<br />   )                                        ;outer loop end<br />   (setvar "OSMODE" HOLDOSMODE)<br />   (vl-cmdf "_.UNDO" "_END")<br />   PTS<br /> )<br /> <br /> (defun C:TTT (/        OS CMD SS PT_LISTMAXY MAXX EN ENT1 EN1 EN2 ENT ARE)<br />                                         <br />   (defun SS1 (A B)<br />     (ssget "C"<br />            ENT1<br />            (list (+ (car ENT1) A) (+ (cadr ENT1) B))<br />            '((-4 . "<NOT")<br />              (-4 . "<OR")<br />              (8 . "right")<br />              (0 . "DIMENSION")<br />              (-4 . "OR>")<br />              (-4 . "NOT>")<br />             )<br />     )<br />   )<br /> <br />   (setq PT_LIST (INTLINES))<br />   (setq CMD (getvar "cmdecho"))<br />   (setvar "cmdecho" 0)<br />   (vl-cmdf "_.undo" "be")<br />   (setq OS (getvar "osmode"))<br />   (setvar "osmode" 0)<br />   (setq<br />     PT_LIST<br />      (vl-sort<br />        PT_LIST<br />        (function<br />          (lambda (P1 P2)<br />            (cond<br />              ((< (atof (rtos (cadr P1) 2 5)) (atof (rtos (cadr P2) 2 5)))<br />               t<br />              )<br />              ((and<br />                 (equal (rtos (cadr P1) 2 5) (rtos (cadr P2) 2 5))<br />                 (< (atof (rtos (car P1) 2 5)) (atof (rtos (car P2) 2 5)))<br />               )<br />               t<br />              )<br />            )<br />          )<br />        )<br />      )<br />   )<br /> <br />   (foreach ENT1        PT_LIST<br />     ;;(300.0)數值在測試中<br />     (setq ENT (list (+ (car ENT1) 300.0) (+ (cadr ENT1) 300.0) 0.0))<br />     (setq EN (entlast))<br />     (vl-cmdf "_.boundary" ENT "")<br />     (setq EN1 (entlast))<br />     (if        (not (equal EN EN1))<br />       (progn<br />         (setq ARE (vla-get-area (vlax-ename->vla-object EN1)))<br />         (cond<br />           ((equal ARE (* 1200.0 1200.0) 0.001)<br />            (if (= (sslength (SS1 1200 1200)) 1)<br />              (vl-cmdf "_.insert" "1100x1100" ENT1 "" "" "")<br />            )<br />           )<br />           ((equal ARE (* 1200.0 600.0) 0.001)<br />            (setq EN2 (AX:GETBOUNDINGBOX EN1))<br />            (if (equal (- (cadadr EN2) (cadar EN2)) 1200 0.001)<br />              (if (= (sslength (SS1 600 1200)) 1)<br />                (progn<br />                  (vl-cmdf "_.insert" "1100x500" ENT1 "" "" "90")<br />                  (vl-cmdf "_.mirror"<br />                           (entlast)<br />                           ""<br />                           ENT1<br />                           (list (car ENT1) (+ 1 (cadr ENT1)))<br />                           "y"<br />                  )<br />                )<br />                ;;(vl-cmdf "_.move" (entlast) "" "0,0" "600,0")<br />              )<br />              (if (= (sslength (SS1 1200 600)) 1)<br />                (vl-cmdf "_.insert" "1100x500" ENT1 "" "" "")<br />              )<br />            )<br />           )<br />           ((equal ARE (* 600.0 600.0) 0.001)<br />            (if (= (sslength (SS1 600 600)) 1)<br />              (vl-cmdf "_.insert" "500x500" ENT1 "" "" "")<br />            )<br />           )<br />         )<br />         (vl-cmdf "_.erase" EN1 "")<br />       )<br />     )<br />   )<br />   (setvar "osmode" OS)<br />   (vl-cmdf "_.undo" "e")<br />   (setvar "cmdecho" CMD)<br />   (princ)<br /> )<br /> ;;-----------------------------<br />

citykunan

谢谢龙版主，万分感谢。

citykunan

在程序中(setq SS (ssget '((0 . "*LINE") (8 . "right"))))这一句，
若改成(setq SS (ssget '((0 . "*LINE"))))便无法运行，不知能不能不把图层放进选择过滤器中？因为每张图的图层并不一定相同，如果只能选择right这一层上的线，程序的局限性太大。
谢谢龙版主。

meflying

注意，有两个地方有这个right的，是不是都改了，