可否实现智能标注

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)
)
(if lst2
(setq lst2 (vl-remove-if '(lambda (x) (equal p x 1e-6)) lst2))
)
)
(setq lst3 (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)
)
)

(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) 
    ) 
    (if  lst2 
      (setq lst2 (vl-remove-if '(lambda (x) (equal p x 1e-6)) lst2)) 
    ) 
  ) 
  (setq  lst3 (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
随便搞了一下，不要悬赏，避让不好搞，您自己琢磨吧

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

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

[提问] 可否实现智能标注

最佳答案

点评

本帖子中包含更多资源

本帖子中包含更多资源

浏览过的版块