[求助]如何能设置标注点到标注线的距离?(禁止liminnet xchrimp跟贴)

caoyin

见24楼

userzhl

liminnet,搞得了？

userzhl

?????????????????????????

xshrimp

2. (defun get-dim-pt (ent / entlst pt10 pt10-1 pt12 pt13 pt13-1 pt14)  
3.   (setq entlst (entget ent))
4.   (if (= "DIMENSION" (dxf 0 entlst))
5.     (progn
6.     (setq pt10 (dxf 10 entlst)pt14 (dxf 14 entlst)pt13 (dxf 13 entlst))
7.     (setq pt10-1 (polar pt10 (+ (* 0.5 pi) (angle  pt10 pt14)) 2))
8.     (setq pt13-1 (polar pt13 (angle pt14 pt10) 2))
9.     (setq pt12 (inters pt10 pt10-1 pt13 pt13-1 nil))
10.     (list ent pt10 pt14 pt12 pt13)
11.     )
12.     nil
13.   )
14. )
15. (defun dxf (i ent)
16.     (if (= (type ent) 'ENAME) (setq ent (entget ent)))
17.     (cdr (assoc i ent))
18. );defun
19. (defun c:test( / dis ent entlst entptlst lst n pt10 pt12 pt13 pt13-new pt14 pt14-new ss)
20. (princ "\n修改标注线的长短，选择标注:")
21. (if (setq ss (ssget "+.:S:E" (list (cons 0 "DIMENSION"))))
22.   (progn
23.    (setq ent (ssname ss 0) entptlst (get-dim-pt ent))
24.    (setq dis (distance (nth 1 entptlst)(nth 2 entptlst)))
25.     (foreach n (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "DIMENSION"))))))
26.     (setq lst (get-dim-pt n) entlst (entget n))
27.     (setq pt10 (nth 1 lst) pt12 (nth 3 lst) pt13 (nth 4 lst) pt14 (nth 2 lst))
28.     (setq pt13-new (polar pt12 (angle pt12 pt13) dis))
29.     (setq pt14-new (polar pt10 (angle pt10 pt14) dis))
30.     (setq entlst (subst (cons 13 pt13-new) (assoc 13 entlst) entlst))
31.     (setq entlst (subst (cons 14 pt14-new) (assoc 14 entlst) entlst))
32.     (entmod entlst)
33.     (entupd n)
34.     )   
35.   )
36. )
37. )

(defun get-dim-pt (ent / entlst pt10 pt10-1 pt12 pt13 pt13-1 pt14)     (setq entlst (entget ent))   (if (= "DIMENSION" (dxf 0 entlst))     (progn     (setq pt10 (dxf 10 entlst)pt14 (dxf 14 entlst)pt13 (dxf 13 entlst))     (setq pt10-1 (polar pt10 (+ (* 0.5 pi) (angle  pt10 pt14)) 2))     (setq pt13-1 (polar pt13 (angle pt14 pt10) 2))     (setq pt12 (inters pt10 pt10-1 pt13 pt13-1 nil))     (list ent pt10 pt14 pt12 pt13)     )     nil   ) ) (defun dxf (i ent)     (if (= (type ent) 'ENAME) (setq ent (entget ent)))     (cdr (assoc i ent)) );defun (defun c:test( / dis ent entlst entptlst lst n pt10 pt12 pt13 pt13-new pt14 pt14-new ss) (princ "\n修改标注线的长短，选择标注:") (if (setq ss (ssget "+.:S:E" (list (cons 0 "DIMENSION"))))   (progn    (setq ent (ssname ss 0) entptlst (get-dim-pt ent))    (setq dis (distance (nth 1 entptlst)(nth 2 entptlst)))     (foreach n (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "DIMENSION"))))))     (setq lst (get-dim-pt n) entlst (entget n))     (setq pt10 (nth 1 lst) pt12 (nth 3 lst) pt13 (nth 4 lst) pt14 (nth 2 lst))     (setq pt13-new (polar pt12 (angle pt12 pt13) dis))     (setq pt14-new (polar pt10 (angle pt10 pt14) dis))     (setq entlst (subst (cons 13 pt13-new) (assoc 13 entlst) entlst))     (setq entlst (subst (cons 14 pt14-new) (assoc 14 entlst) entlst))     (entmod entlst)     (entupd n)     )      ) ) )

userzhl

xshrimp，厉害！！

非常感谢！

userzhl

经过测试，有问题，当标注起点与标注线距离为0时，会有出错。

userzhl

被liminnet忽悠了。

不想他跟我的贴。

wuxuloveguo

你指望他liminnet 帮你整?嘿嘿~看看他的东西都是东凑西凑的,要他能估计得问好多人了!