社区 › AutoLISP/Visual LISP 编程技术 › 可否实现智能标注

ddqzmpaxlozc 发表于 2020-3-16 00:41:43

可否实现智能标注

本帖最后由 ddqzmpaxlozc 于 2020-3-18 13:04 编辑

求大佬给加个标注避让的功能
避让规则：如图效果，确实是比较难实现

x_s_s_1 发表于 2020-3-16 00:41:44

随便搞了一下，不要悬赏，避让不好搞，您自己琢磨吧


(defun c:test1 (/ ss1 n en ent lst1a lst1b ss2 lst2 lst3 m p pa pb pc)
(prompt "\n选择定位线:")
(setq ss1 (ssget '((0 . "line"))))
(repeat (setq n (sslength ss1))
    (setq en(ssname ss1 (setq n (1- n)))
    ent (entget en)
    )
    (if(equal (car (cdr (assoc 10 ent)))
         (car (cdr (assoc 11 ent)))
         1e-6
)
      (setq lst1a (cons en lst1a))
      (setq lst1b (cons en lst1b))
    )
)
(prompt "\n选择标示物:")
(setq ss2 (ssget '((0 . "*line,point,circle,arc"))))
(repeat (setq n (sslength ss2))
    (setq en(ssname ss2 (setq n (1- n)))
    ent (entget en)
    )
    (cond ((member (cdr (assoc 0 ent)) '("POINT" "CIRCLE"))
   (setq lst2 (cons (cdr (assoc 10 ent)) lst2))
    )
    ((member (cdr (assoc 0 ent)) '("LINE" "ARC"))
   (setq lst2 (cons (vlax-curve-getstartpoint en) lst2))
   (setq lst2 (cons (vlax-curve-getendpoint en) lst2))
    )
    ((member (cdr (assoc 0 ent)) '("LWPOLYLINE" "POLYLINE"))
   (setq m (vlax-curve-getendParam en))
   (while (>= m 0)
       (setq lst2(cons (vlax-curve-getpointatparam en m) lst2)
       m(1- m)
       )
   )
    )
    )
)
(while lst2
    (setq p    (car lst2)
    lst(cdr lst2)
    lst3 (cons p lst3)
    )
    (iflst2
      (setq lst2 (vl-remove-if '(lambda (x) (equal p x 1e-6)) lst2))
    )
)
(setqlst3 (vl-sort lst3
          '(lambda (p1 p2)
       (if (equal (car p1) (car p2) 1e-6)
         (< (cadr p1) (cadr p2))
         (< (car p1) (car p2))
       )
         )
       )
)
(foreach n lst3
    (setq
      lst2 (mapcar
       '(lambda (x) (list n (vlax-curve-getclosestpointto x n t)))
       lst1a
   )
      lst2 (vl-sort lst2
      '(lambda (p1 p2)
         (< (distance (car p1) (cadr p1))
      (distance (car p2) (cadr p2))
         )
         )
   )
    )
    (setq p(car lst2)
    pa (car p)
    pb (cadr p)
    pc (polar pa (* 0.5 pi) 500)
    )
    (command "dimlinear" pa pb pc)
    (setq
      lst2 (mapcar
       '(lambda (x) (list n (vlax-curve-getclosestpointto x n t)))
       lst1b
   )
      lst2 (vl-sort lst2
      '(lambda (p1 p2)
         (< (distance (car p1) (cadr p1))
      (distance (car p2) (cadr p2))
         )
         )
   )
    )
    (setq p(car lst2)
    pa (car p)
    pb (cadr p)
    pc (polar pa 0 500)
    )
    (command "dimlinear" pa pb pc)
)
)

mikewolf2k 发表于 2020-3-16 08:55:03

做过管道平面布置图的自动标注功能,只要规则确定,是可以实现的.

cable2004 发表于 2020-3-16 11:41:25

本帖最后由 cable2004 于 2020-3-16 11:42 编辑

初稿，可能还有bug。

ddqzmpaxlozc 发表于 2020-3-16 12:36:42

cable2004 发表于 2020-3-16 11:41
初稿，可能还有bug。

大神可以啊，是我想要的效果，你这个是对象只是圆心吗，可以是选择点吗，或者是一段线的端点，折点呢，可以实现吗

ddqzmpaxlozc 发表于 2020-3-16 12:38:32

cable2004 发表于 2020-3-16 11:41
初稿，可能还有bug。

发来瞧瞧嘛

ddqzmpaxlozc 发表于 2020-3-16 17:23:00

cable2004 发表于 2020-3-16 11:41
初稿，可能还有bug。

大佬加油啊！

pw_design 发表于 2020-3-17 01:53:01

学习一下喽

ddqzmpaxlozc 发表于 2020-3-17 12:58:46

cable2004 发表于 2020-3-16 11:41
初稿，可能还有bug。

大佬你研究的咋样了

ddqzmpaxlozc 发表于 2020-3-17 20:54:31

x_s_s_1 发表于 2020-3-17 19:08
随便搞了一下，不要悬赏，避让不好搞，您自己琢磨吧

感谢大佬支持，我先下载测试一下

查看完整版本: 可否实现智能标注