[求助]植被填充好程序，明总能不能翻译成Ｃ＃或VB版本？？

菜鸟Liu · 发表于 2012-3-13 21:28:00

在CAD二次开发应该会经常遇到（闭合）Polyline的填充问题，在论坛里没有找到类似的例子？？由于是填充自定义的各种符号（如自定义块参照），使用Hatch命令未能实现或达到效果，偶然发现下面这个植被填充程序，可惜是Lisp版本，很难看懂，能不能麻烦各位明总和高手们抽时间帮忙翻译成VB或C#版本（最好是最新的.Net API版本），选择新的开发方式缺乏这样好的资源做参考。
// 问题定义：植被填充
// 转载自：http://www.objectarx.net/forum.php?mod=viewthread&tid=8985
// 理想效果：

s1w4mjhjozc.png

// Lisp版本如下：
选择多段线，重量线  如果是轻量线可以用convertpoly 命令来转换
(DEFUN C:ZB()
(setq os (getvar "osmode")) ;获取系统当前点捕捉模式
(setvar "osmode" 0)          ;取消点捕捉
(command "linetype" "s" "continuous" "") ;设置线型
(command "layer" "m" "ZB" "s" "ZB" "")    ;设置图层
(setq sn (entsel "\n选择要填充植被符号的Polyline封闭线:"))
(setq sn (car sn))
(setq s1 sn)
(setq pname (getstring "\n输入植被符号图块名称:"))
(Point_Pline)       ;获取Polyline线顶点坐标
;计算多边形外接最大矩形----------------------开始
(setq n (length b) n0 0)
(while ( x x2) (setq x2 x))
               (if (> y y2) (setq y2 y))
         )
   )
)
;计算多边形外接最大矩形----------------------结束
  (setq s_long 0);判断插入1个符号或多个符号的标志(0一个/1多个)
  (if (and (> (- x2 x1) 5)(> (- y2 y1) 5))
   (progn
      ;当外接矩形长、宽都大于5mm时，计算并填充植被符号
      (setq p1 '(0 0) p2 p1)
      (while ( s2 (* rowd rowd))
         (progn
            ;如果填充多边形面积s2>100,计算植被符号插入位置
            (setq s_long 1)
            ;绘填充多边形内或外的平行多边形
            (command "offset" "0.4" S1 poin "")
            (setq sn (entlast))
            (command "area" "E" sn)  ;计算平行多边形的面积
            (setq s3 (getvar "area"))  ;s3=平行多边形的面积
            (entdel sn)       ;删除平行多边形的面积
            (if (> s3 s2)
                  (command "OFFSET" "2" s1
                                    (polar p (+ a1 pi) 0.1)
                           ""
                  )
                  (command "OFFSET" "2" S1 poin "")
            ) ;确认填充多边形的内多边形并绘制
            (setq sn (entlast))
            (Point_Pline)  ;取得内多边形顶点坐标表B
            (entdel sn)  ;删除内多边形
         );progn
      );if s2
   )
)
(if (= s_long 0)
      ;只绘一个符号
      (COMMAND "INSERT" pname
                        (list (* 0.5 (+ x1 x2)) (* 0.5 (+ y1 y2)))
                        1 1 ""
      )
   (progn
      ;绘多个符号
      ;计算内多边形外接最大矩形----------------------开始
      (setq n (length b))
      (setq n0 0)
      (while ( x x2) (setq x2 x))
                        (if (> y y2) (setq y2 y))
               )
            );if
      )  ;while
      ;计算内多边形外接最大矩形----------------------结束
      ;计算符号插入点并插入符号----------------------开始
      (SETQ  L (- X2 X1) W (- Y2 Y1))
      (SETQ COLD (/ ROWD 2.0) DY 0.0 NUM 1)
      (setq n (- n 1))
      (setq p '(-1000000 -100000)) ;在填充区域外设定一点
      (WHILE ( (distance b0  b1) 0.004)
                           (setq bb (cons b1 bb))
                     )
                     (setq b0 b1)
                     (setq nb0 (+ nb0 1))
      )
      (setq b (reverse bb))
);END

euzifzs2snz.png

该贴已经同步到