社区 › VB › 基于它们的位置选择形状”；“在”内；另一个对象。

michael_h 发表于 2008-4-25 13:03:08

基于它们的位置选择形状”；“在”内；另一个对象。

嗨，朋友们，
我是一名架构研究员(不是架构师)，我不知道如何编写一个小程序。在一些AutoCad的东西上，我相当有见识，但是因为我是自学的，所以我的知识中肯定会有一些漏洞，所以没有建议是太愚蠢了。
我有许多平面布置图，需要使用一个名为DepthMap的程序进行分析(这基本上是一个可视化分析程序)。这个程序可以将数据输出到一个文本文件中，我已经创建了一个awk(基于Linux的)程序，将数据转换为AutoCad脚本。运行时，该脚本在AutoCad模型的新图层上“绘制”深度图程序中的数据。每个数据点都是三维矩形的形式，其中x和y给出了x和y位置，厚度表示来自DepthMap程序的数据。每个数据点都用一种特定的算法着色——下面我给出了一个例子。
color 180
_ rectang thickness 3.18203 0，15 0.99，15.99
我倾向于有很多这样的小数据点(一般> 3万)。我想做的是能够在一个单独的层上绘制一个区域(理想情况下是一个多边形)，然后创建一个AutoCad程序，自动选择该区域内的所有数据点。然后，我想将这些数据点的属性导出到Excel(谢天谢地，我知道如何导出到Excel)。
我想在单独的图层上绘制这些区域的原因是，有时我需要返回并为不同的分析选择相同的数据点，并且我需要确保每次都获得相同的数据点。此外，由于这些计划中有许多重复的、形状奇怪的房间，我希望能够一次性绘制一个多边形区域并复制/粘贴它，而不是尝试手动选择大量繁琐的数据点。
因此，简而言之:
我在图层A上有许多小矩形。
我在图层b上有由多边形定义的区域。
我想编写一个脚本，导出图层A上每个矩形的属性，这些属性落在图层b上每个多边形的界限内。
任何建议都是非常受欢迎的，即使只是引用一个可能有用的函数。谢谢，
迈克尔
**** Hidden Message *****

Fatty 发表于 2008-4-26 06:56:34

试试这个，它是两年前为一个来自
意大利的家伙写的，看起来和你想解决的任务一样
(defun c:WPL        (/ Collector Color Coors Data Dz Elist En First_String Fn Fname        I P1 P3        Ptlist Rect Second_String Ss
               Thick Tmpss)
    (setq dz (getvar "dimzin"))
    (setvar "dimzin" 8)
    (command "_zoom" "_e")
    (if        (setq ss (ssget        "_X"
                        (list
                          (cons -4 "")
                          )
                        )
              )
      (progn
        (setq i -1)
        (repeat        (sslength ss)
          (setq en (ssname ss (setq i (1+ i))))
          (setq
          ptlist (vl-remove-if
                     (function not)
                     (mapcar
                     (function (lambda (x)
                                   (if (= 10 (car x))
                                     (list (car (cdr x)) (cadr (cdr x)))
                                     )
                                   )
                               )
                     (entget en)
                     )
                     )
          )
          (setq        tmpss (ssget "_CP"
                             ptlist
                             (list
                             (cons -4 "")
                             )
                             )
                )
          (if tmpss
          (while
              (setq rect (ssname tmpss 0))
             (setq collector (cons rect collector))
             (ssdel rect tmpss)
             )
          )
          )
        )
      (alert "No boundaries with \nthese properties")
      )
    (command "_zoom" "_p")
    (foreach itmcollector
      (setq elist (entget itm))
      (setq coors (vl-remove-if
                  (function not)
                  (mapcar (function (lambda (x)
                                        (if (equal 10 (car x))
                                          (cdr x)
                                          )
                                        )
                                      )
                          elist
                          )
                  )
          )
      (setq p1 (car coors)
;;;              p2 (cadr coors)
          p3 (caddr coors)
;;;              p4 (cadddr coors)
          )
      (setq thick (cdr (assoc 40 elist))
          color (cdr (assoc 62 elist))
          )
      (setq first_string(strcat "color " (itoa color))
          second_string (strcat "_rectang thickness "
                                  (rtos thick 2 5)
                                  " "
                                  (rtos (car p1) 2 2)
                                  ","
                                  (rtos (cadr p1) 2 2)
                                  " "
                                  (rtos (car p3) 2 2)
                                  ","
                                  (rtos (cadr p3) 2 2)
                                  )
          )
      (setq data (cons first_string data)
          data (cons second_string data))
      )
    (setq data (reverse data))
    (setq fname        (strcat        (getstring
                          "\nEnter text file name w/o extension to save data: ")
                        ".txt"))
    (setq fn (open (strcat (getvar "dwgprefix") fname) "w"))
    (mapcar (function (lambda (x) (write-line x fn)))
          data
          )
    (close fn)
    (alert "done")
    (setvar "dimzin" dz)
    (princ)
    )
(princ "\n>> Start command with WPL")
(prin1)
~'J'~

Fatty 发表于 2008-4-26 14:21:55

抱歉，Michael，我忘了这是VBA分行
试试这个代码1]
~'J'~

michael_h 发表于 2008-4-27 12:36:56

胖子，
谢谢，我非常感谢。我们在学期末就到了，所以批改论文等可能意味着这需要几天的时间，但这非常有帮助！

Fatty 发表于 2008-4-27 14:49:14

不客气，迈克尔
祝你顺利度过这学期
~'J'~

查看完整版本: 基于它们的位置选择形状”；“在”内；另一个对象。