renox 发表于 2012-12-3 12:36:49

任意四边形，求框选标出对角线，如图

本帖最后由 renox 于 2013-1-19 17:00 编辑

ZZXXQQ 发表于 2012-12-3 12:36:50

本帖最后由 ZZXXQQ 于 2012-12-15 08:44 编辑


;框选标注四边形对角线 明经 ZZXXQQ 2012.12.12 12.15改
(defun c:tt ()
(setvar "CMDECHO" 0)
(if (setq ss (ssget '((0 . "LWPOLYLINE") (90 . 4)))) (progn
(setq i -1)
(repeat (sslength ss)
   (setq ent (entget(ssname ss (setq i (1+ i)))))
   (setq lst (list))
   (foreach x ent (if (= (car x) 10) (setq lst (cons (cdr x) lst))))
   (setq p1 (car lst) p2 (cadr lst)
         p3 (caddr lst) p4 (last lst))
   (setq p5 (inters p1 p3 p2 p4 nil))
   (command "_DIMALIGNED" p1 p3
            (polar p5 (angle p5 p4) (/ (distance p5 p4) 2))
;(mapcar '(lambda (x y) (/ (+ x y) 2)) p5 p4)
   )
   (command "_DIMALIGNED" p2 p4
            (polar p5 (angle p5 p3) (/ (distance p5 p3) 2))
;(mapcar '(lambda (x y) (/ (+ x y) 2)) p5 p3)
   )
)
))
(setvar "CMDECHO" 1)
(princ)
)

Andyhon 发表于 2012-12-3 13:14:34

建议提供调试用验证图文件(*.dwg)

renox 发表于 2012-12-3 13:19:00

好的，我马上传上来。谢谢

renox 发表于 2012-12-3 13:20:21

我马上传上来。

Andyhon 发表于 2012-12-3 16:11:34

试了一下,发觉若要处理尺寸文字错开会复杂些...

renox 发表于 2012-12-3 16:14:16

能不能给我试下啊，

renox 发表于 2012-12-3 16:18:39

Andyhon 发表于 2012-12-3 16:11 static/image/common/back.gif
试了一下,发觉若要处理尺寸文字错开会复杂些...

兄弟能发给我试下吗

Andyhon 发表于 2012-12-3 16:39:54

卡在 Region

renox 发表于 2012-12-3 16:43:03

Andyhon 发表于 2012-12-3 16:39 static/image/common/back.gif
卡在 Region

兄弟能发到我QQ邮箱里吗。328947135@qq.com
页: [1] 2 3 4 5 6 7 8 9
查看完整版本: 任意四边形，求框选标出对角线，如图