wayi2002 发表于 2007-9-23 22:18:00

求多边形面积标注、填充这样的程序

求这样的程序，选取多边形--自动在中心位置标注面积文字“A=？？？？”同时填充左斜线且斜线不占压“A=？？？？”，谢谢。

蓝盾设计 发表于 2018-8-2 19:06:51

终于找到了，自己想要的资料！

ZZXXQQ 发表于 2007-10-1 21:53:00


(DEFUN C:TT ()
(SETVAR "CMDECHO" 0)
(IF (AND (PRINC "\nSelect A Polygon 选择一多边形 :")
          (SETQ SS (SSGET '((0 . "LWPOLYLINE"))))) (PROGN
(SETQ EN (SSNAME SS 0)
      ENT (ENTGET EN) I -1 TML (LIST))
(REPEAT (LENGTH ENT)
   (IF (= (CAR (SETQ TMP (NTH (SETQ I (1+ I)) ENT))) 10)
    (SETQ TML (CONS (CDR TMP) TML))
   )
)
(SETQ PT1 (CAR TML) PT2 (CADR TML) PT3 (CADDR TML))
(SETQ PM1 (POLAR PT1 (ANGLE PT1 PT2) (/ (DISTANCE PT1 PT2) 2))
      PM2 (POLAR PT2 (ANGLE PT2 PT3) (/ (DISTANCE PT2 PT3) 2))
PF1 (POLAR PM1 (+ (ANGLE PT1 PT2) (/ PI 2)) 3)
PF2 (POLAR PM2 (+ (ANGLE PT2 PT3) (/ pi 2)) 3)
PC (INTERS PM1 PF1 PM2 PF2 nil))
(COMMAND "AREA" "E" EN "")
(SETQ TXTA (STRCAT "A=" (RTOS (GETVAR "AREA") 2 2)))
(COMMAND "TEXT" "M" PC "" 0 TXTA)
(COMMAND "HATCH" "_U" 45 "" "" "L" EN "")
))
(SETVAR "CMDECHO" 1)
(PRINC)
)

sy100 发表于 2007-10-23 19:06:00

谢谢ZZXXQQ ，求同一类似程序，只要求上述填充的图案能够修改成其它图案！

124350440 发表于 2010-8-15 11:39:00

<p>借楼主帖子发个问，能否修改“选取多边形”为“拾取边界”然后其它功能同楼主的不变啊？</p>

cxs259 发表于 2010-8-19 08:55:00

<p>请问ZZXXQQ版主能否换成平方米？谢谢！</p>

gufeng 发表于 2010-8-19 09:45:00

<p>把代码19行中的 (GETVAR "AREA") 修改即可 如要面积除以1000修改成 (/ (GETVAR "AREA") 1000)</p>

cxs259 发表于 2010-8-19 16:58:00

<p>哦，谢谢古大侠！</p>
<p>&nbsp;</p>

cxs259 发表于 2010-8-23 11:16:00

<p>请问标注文字大小能否随图形大小而变化呢？</p>
<p>&nbsp;</p>

another2121 发表于 2010-12-13 11:28:52

值得借鉴。。。

669423907 发表于 2011-3-31 23:05:23

高手！下载了！
页: [1] 2
查看完整版本: 求多边形面积标注、填充这样的程序