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

wayi2002

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

蓝盾设计

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

ZZXXQQ

2. (DEFUN C:TT ()
3. (SETVAR "CMDECHO" 0)
4. (IF (AND (PRINC "\nSelect A Polygon 选择一多边形 :")
5.           (SETQ SS (SSGET '((0 . "LWPOLYLINE"))))) (PROGN
6.   (SETQ EN (SSNAME SS 0)
7.         ENT (ENTGET EN) I -1 TML (LIST))
8.   (REPEAT (LENGTH ENT)
9.    (IF (= (CAR (SETQ TMP (NTH (SETQ I (1+ I)) ENT))) 10)
10.     (SETQ TML (CONS (CDR TMP) TML))
11.    )
12.   )
13.   (SETQ PT1 (CAR TML) PT2 (CADR TML) PT3 (CADDR TML))
14.   (SETQ PM1 (POLAR PT1 (ANGLE PT1 PT2) (/ (DISTANCE PT1 PT2) 2))
15.         PM2 (POLAR PT2 (ANGLE PT2 PT3) (/ (DISTANCE PT2 PT3) 2))
16.   PF1 (POLAR PM1 (+ (ANGLE PT1 PT2) (/ PI 2)) 3)
17.   PF2 (POLAR PM2 (+ (ANGLE PT2 PT3) (/ pi 2)) 3)
18.   PC (INTERS PM1 PF1 PM2 PF2 nil))
19.   (COMMAND "AREA" "E" EN "")
20.   (SETQ TXTA (STRCAT "A=" (RTOS (GETVAR "AREA") 2 2)))
21.   (COMMAND "TEXT" "M" PC "" 0 TXTA)
22.   (COMMAND "HATCH" "_U" 45 "" "" "L" EN "")
23. ))
24. (SETVAR "CMDECHO" 1)
25. (PRINC)
26. )

复制代码

sy100

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

124350440

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

cxs259

请问ZZXXQQ版主能否换成平方米？谢谢！

gufeng

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

cxs259

哦，谢谢古大侠！

 

cxs259

请问标注文字大小能否随图形大小而变化呢？

 

another2121

值得借鉴。。。

669423907

高手！下载了！