[LISP] 求助 meflying

zhongguola · 发表于 2005-9-14 15:17

您曾经帮我编过标注边长的程序：

(defun c:Dimline( / dir gap ss i ent ents pts)
(vl-load-com)
(setq dir (getstring "\n选择方向[(A)顺时针外部/(B)顺时针内部](逆时针则相反)<A>:"))
(setq gap (getreal "\n输入标注文字到边边距离:"))
(if (= (strcase dir) "B")
    (setq dir 0)
    (setq dir pi)
)
(setq ss (ssget '((0 . "LWPOLYLINE"))))
(setq i 0)
(setvar "cmdecho" 0)
(if ss
    (progn
      (repeat (sslength ss)
(setq ent (ssname ss i))
(setq ents (entget ent))
(setq pts (mapcar 'cdr (vl-remove-if-not '(lambda (e) (= (car e) 10)) ents)))
(mapcar '(lambda(e1 e2) (command "_.dimaligned" e1 e2 (polar e1 (+ dir (angle e1 e2) (/ pi 2.0)) gap)))
   pts (append (cdr pts) (list (car pts))))
(setq i (1+ i))
      )
    );progn
);if
(princ)
)

这个程序每次标注必需要先选多义线，如果图形中有很多个多义线就会很麻烦。

求助meflying能不能在此程序的基础上改编一下，使其在由多个LINE线组成的

多边形区域内点击，可以自动生成边界并能够根据边界自动标注边长，最后删除边界线。

小弟先向大哥道声谢了！！！！！

ZZXXQQ · 发表于 2005-9-14 16:33

版主忙，我改一下：（程序未经调试）

(defun c:Dimline( / dir gap ss i ent ents pts)
(vl-load-com)
(setq dir (getstring "\n选择方向[(A)顺时针外部/(B)顺时针内部](逆时针则相反)<A>:"))
(setq gap (getreal "\n输入标注文字到边边距离:"))
(if (= (strcase dir) "B")
(setq dir 0)
(setq dir pi)
)
(INITGET 1)
(setq pt (getpoint "\n请点取要标注的范围内一点:"))
(command "-boundary" pt "")
(setvar "cmdecho" 0)
(if (SETQ SS (ENTLAST)) (progn
(setq ents (entget SS))
(setq pts (mapcar 'cdr (vl-remove-if-not '(lambda (e) (= (car e) 10)) ents)))
(mapcar '(lambda(e1 e2) (command "_.dimaligned" e1 e2 (polar e1 (+ dir (angle e1 e2) (/ pi 2.0)) gap)))
pts (append (cdr pts) (list (car pts))))
);progn
);if
(princ)
)

zhongguola · 发表于 2005-9-15 08:28

很好用。

非常感谢！！！！

经典的教材！

ZZXXQQ · 发表于 2005-9-15 08:42

在);progn前应该再加上一行(entdel ss)。

zhongguola · 发表于 2005-9-15 11:08

谢谢！

zhongguola · 发表于 2005-9-15 11:10

请问(INITGET 1)
是什么意思呀！

ZZXXQQ · 发表于 2005-9-15 14:51

zhongguola发表于2005-9-15 11:10:00请问(INITGET 1)是什么意思呀！

非空。其后的GETPOINT不能空输入。

zhongguola · 发表于 2005-9-15 15:17

高！实在是高！

谢！

账号		自动登录	找回密码
密码			注册