社区 › AutoLISP/Visual LISP 编程技术 › 【Gu_xl】基于方位角计算的拓扑多边形自动构建快速算法

tm20038175 发表于 2012-9-20 11:20:45

建议大家研究下这个帖子，在划分单元时候很实用，也十分感谢miraclelll的完善和优化…

漫长的等待 发表于 2012-9-20 14:35:49

先收下了，谢谢！

tm20038175 发表于 2012-9-20 19:02:58

呵呵，的确是好程序。

tm20038175 发表于 2012-9-22 20:32:42

miraclelll 发表于 2012-9-20 10:29 static/image/common/back.gif
哦,对不起, 忘记附上去了.... 以下是我优化后的 删除外包多边形

原来的思路是: 将每一个多边形和其他 ...

还是缺很多函数，例如：
1.SETUNDOERR
2.GXL-STR-SPACE
哎，等了一年还是没有解决~~~~~

123523058 发表于 2012-11-17 08:21:11

希望看到完整的源码 谢谢大师

阿然 发表于 2012-11-17 09:28:25

这么好的东西，先马克下，等发帖数够了慢慢研究！

阿然 发表于 2012-11-17 19:27:01

古大，你这个程序为什么不支持pline呢？

mp13119 发表于 2012-12-10 16:49:14

本帖最后由 mp13119 于 2012-12-10 16:50 编辑

虽然看不懂！但觉得楼主很厉害！不知道楼主的程序能实现这样的功能吗？

Gu_xl 发表于 2012-12-10 19:58:08

本帖最后由 Gu_xl 于 2012-12-10 20:51 编辑

mp13119 发表于 2012-12-10 16:49 static/image/common/back.gif
虽然看不懂！但觉得楼主很厉害！不知道楼主的程序能实现这样的功能吗？
这个动态定义填充图案填充即可！

(defun c:tt (/      X      Y      _A      PATNAME INDEX   PATH
      DIMZIN      OX      OY      F      FILENAME
      STR   cmdecho *error*
   )
(defun *error* (s)
    (setvar 'dimzin dimzin)
    (setvar 'cmdecho cmdecho)
    (pronc s)
)
(setq x (getreal "\nX间距:<10.0>"))
(if (null x)
    (setq x 10)
)
(setq y (getreal "\nY间距:<10.0>"))
(if (null y)
    (setq y 10)
)
(setq _a (getangle "\n旋转角度<0>:"))
(if (null _a)
    (setq _a "0")
    (setq _a (angtos _a))
)
(setq patname "TEMPPA_"
index 0
)
(while
    (ssget "x"
    (list '(0 . "hatch") (cons 2 (strcat patname (itoa index))))
    )
   (setq index (1+ index))
)
(setq patname (strcat patname (itoa index)))
(setq path (GETVAR (QUOTE ROAMABLEROOTPREFIX))
dimzin (getvar (quote dimzin))
cmdecho (getvar 'cmdecho)
)
(setvar 'dimzin 8)
(setvar 'cmdecho 0)
(or (eq "\\" (substr path (strlen path)))
      (setq path (strcat path "\\"))
)
(setq path (strcat path "Support\\"))
(setq f (open (setq filename (strcat path patname ".pat")) "w"))
(write-line
    (setq str (strcat "*" patname ",临时填充图案 " patname))
    f
)
(write-line (strcat "0,0,0,0," (rtos x 2 10)) f)
(write-line (strcat "90,0,0,0," (rtos y 2 10)) f)
(close f)
(setq endent (entlast))
(if (>= (atoi (getvar 'acadver)) 17)
    (progn
      (command "_Bhatch" "p" patname "1" _a "o" "d" "l" "n")
      (princ "\n**选择区域点**")
      (while (= 1 (getvar 'cmdactive))
(command pause)
      )
    )
    (progn
      (command "_Bhatch" "p" patname "1" _a)
      (princ "\n**选择区域点**")
      (while (= 1 (getvar 'cmdactive))
(command pause)
      )
    )
)
(setq hatch (entlast))
(if (not (equal endent hatch))
    (command "_explode" hatch)
)
(vl-file-delete filename)
(setvar 'dimzin dimzin)
(setvar 'cmdecho cmdecho)
(princ)
)

soly2006 发表于 2012-12-11 00:09:30

\能否对多段线进行拓扑计算？
正想用到检查小构面的内容。

查看完整版本: 【Gu_xl】基于方位角计算的拓扑多边形自动构建快速算法