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

citykunan · 发表于 2004-1-14 10:40:00

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

本帖以下内容被隐藏保护；需要你回复后，才能看到！

游客，如果您要查看本帖隐藏内容请回复

citykunan · 发表于 2004-1-15 10:50:00

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

请点击此处下载

请先注册会员后在进行下载

已注册会员，请先登录后下载

文件名称:sg1z2iamc4s.lsp
下载次数:0 文件大小:1.83 KB 售价:2银币 [记录]
下载权限: 不限以上或 Vip会员 [开通Vip] [签到领银币] [免费赚银币]

龙龙仔 · 发表于 2004-1-15 12:28:00

copy


;;有是有,只是要先框選到要插入圖塊的圍範,不夠完整
;;BY 龍龍仔(LUCAS)
;;-------------------------------------------------------------
(defun GETINTERPOINTS (ENT2 / E2 PT3 PT4)
  (setq E2 (entget ENT2))
  (setq PT3 (cdr (assoc 10 E2)))
  (setq PT4 (cdr (assoc 11 E2)))
  (inters PT1 PT2 PT3 PT4)
)
(defun GETALLINTERS (SS / N I J ENT1 POINTS POINT S1 PT1 PT2)
  (setq        N      (sslength SS)
        POINTS '()
  )
  (setq I 0)
  (repeat N
    (setq ENT1 (ssname SS I))
    (setq PT1 (cdr (assoc 10 (entget ENT1))))
    (setq PT2 (cdr (assoc 11 (entget ENT1))))
    (setq S1 (ssget "F" (list PT1 PT2)))
    (setq J 0)
    (repeat (sslength S1)
      (if (and (setq POINT (GETINTERPOINTS (ssname S1 J)))
               (not (member POINT POINTS))
          )
        (setq POINTS (append POINTS (list POINT)))
      )
      (setq J (1+ J))
    )
    (setq I (1+ I))
  )
  POINTS
)
(defun C:TTT (/ OS CMD SS PT_LIST)
  (setq OS (getvar "osmode"))
  (setq CMD (getvar "cmdecho"))
  (setq SS (ssget '((0 . "LINE"))))
  (command "_.undo" "be")
  (setvar "osmode" 0)
  (setvar "cmdecho" 0)
  (setq PT_LIST (GETALLINTERS SS))
  (setq
    PT_LIST
     (vl-sort PT_LIST
              (function
                (lambda        (P1 P2)
                  (cond        ((vla-object AOBJ1)
          N2        (1+ N1)
    )                                        ;index for inner loop
;;; Inner loop, go through remaining objects
    (while (vla-object AOBJ2)
;;;Find intersections of Objects
            IPTS  (vla-intersectwith
                    AOBJ1
                    AOBJ2
                    0
                  )                        ; variant result
            IPTS  (vlax-variant-value IPTS)
      )
;;;Variant array has values?
      (if (> (vlax-safearray-get-u-bound IPTS 1) 0)
        (progn                                ;array holds values, convert it
          (setq        IPTS                        ;to a list.
                 (vlax-safearray->list IPTS)
          )
;;;Loop through list constructing points
          (while (> (length IPTS) 0)
            (setq PTS  (cons (list (car IPTS)
                                   (cadr IPTS)
                                   (caddr IPTS)
                             )
                             PTS
                       )
                  IPTS (cdddr IPTS)
            )
          )
        )
      )
      (setq N2 (1+ N2))
    )                                        ;inner loop end
    (setq N1 (1+ N1))
  )                                        ;outer loop end
  (setvar "OSMODE" HOLDOSMODE)
  (command "_.UNDO" "_END")
  PTS
)
(defun C:TTT (/ OS CMD SS PT_LIST EN ENT1 EN1 ENT ARE)
  (setq PT_LIST (INTLINES))
  (setq CMD (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (command "_.undo" "be")
  (setq OS (getvar "osmode"))
  (setvar "osmode" 0)
  (setq
    PT_LIST
     (vl-sort PT_LIST
              (function
                (lambda        (P1 P2)
                  (cond        ((vla-object 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)
)
;;-------------------------------------------------------------

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

无痕 · 发表于 2004-1-15 18:54:00

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

请点击此处下载

请先注册会员后在进行下载

已注册会员，请先登录后下载

文件名称:qtgwh3t5awr.dwg
下载次数:0 文件大小:41.58 KB 售价:2银币 [记录]
下载权限: 不限以上或 Vip会员 [开通Vip] [签到领银币] [免费赚银币]

龙龙仔 · 发表于 2004-1-16 07:52:00

copy


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

citykunan · 发表于 2004-1-16 13:14:00

谢谢龙版主，万分感谢。

龙龙仔 · 发表于 2004-1-16 16:12:00

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

citykunan · 发表于 2004-1-19 09:14:00

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

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

发表回复

精选推荐