【CC】序号标注带引线
(defun c:cc()
(setvar "cmdecho" 0)
(if (= ccvar nil)(setq ccvar (list 2.5 3 1 1 "N" "")))
(setq r(getreal (strcat "\n圆圈半径<" (rtos (car ccvar)) ">:")))
(setq h(getreal (strcat "\n输入字高<" (rtos (cadr ccvar)) ">:")))
(setq n(getint(strcat "\n起始序号<" (itoa (caddr ccvar)) ">:")))
(setq b(getint(strcat "\n序号位数[前面补0]<" (itoa (cadddr ccvar)) ">:")))
(initget 0 "Y N")
(setq k (getkword (strcat "\n是否设置前缀(Y)/(N)<" (nth 4 ccvar)">:")))
(if (= k nil)(setq k (nth 4 ccvar)))
(setq s "" marks (nth 5 ccvar))
(if (= k "Y") (progn
(setq s (getstring (strcat "\n设置前缀<" marks ">:")))
(if (= s "")(setq s marks)(setq marks s))
))
(if (= r nil)(setq r (car ccvar)))
(if (= h nil)(setq h (cadr ccvar)))
(if (= n nil)(setq n (caddr ccvar)))
(if (= b nil)(setq b (cadddr ccvar)))
(setq ss "" bb (itoa n))
(while (setq pt (getpoint "\n指定起点:"))
(setq ceo nil)
(repeat (- b (strlen bb)) (setq ss (strcat ss "0")))
(if (> r 0) (progn (command "circle" pt r) (setq ceo (entget (entlast)))))
(command "text" "J" "mc" pt h "" (strcat s ss bb))
(setq teo (entget (entlast)))
(command "leader" pt (polar pt (/ pi 4) r)"" "" "n")
(setq leo (entget (entlast)))
(setq p1 (cdr (assoc 10 leo)) k 1)
(while (/= k 3)
(setq p (grread T))
(setq k (car p) p (cadr p))
(if (> r 0) (progn
(setq ceo (subst (cons 10 p) (assoc 10 ceo) ceo))
(entmod ceo)
))
(setq teo (subst (cons 11 p) (assoc 11 teo) teo))
(entmod teo)
(setq p (polar p (angle p p1) r))
(setq leo (subst (cons 10 p) (assoc 10 (reverse leo)) leo))
(if (> (distance p p1) 0.0) (entmod leo))
)
(setq n (1+ n) ss "" bb (itoa n))
)
(setq ccvar (list r h n b k marks))
(setvar "cmdecho" 1)
(princ)
)
(princ "\n命令:CC")
(prin1) ;;此程序有2个BUG：
;;1、选用的字体样式的字高必须设置为0，否则标注错误，望高手修复！
;;2、引线的箭头始终显示为1:1的绘图比例，比如字高和圆圈半径放大了100倍，引线箭头不会放大100倍。
(defun c:cc(/ b bb ceo h k leo marks n p p1 pt r s ss teo)
(setvar "cmdecho" 0)
(if (= ccvar nil)(setq ccvar (list 2.5 3 1 1 "N" "")))
(setq r(getreal (strcat "\n圆圈半径<" (rtos (car ccvar)) ">:")))
(setq h(getreal (strcat "\n输入字高<" (rtos (cadr ccvar)) ">:")))
(setq n(getint(strcat "\n起始序号<" (itoa (caddr ccvar)) ">:")))
(setq b(getint(strcat "\n序号位数(前面补0)<" (itoa (cadddr ccvar)) ">:")))
(initget 0 "Y N")
(setq k (getkword (strcat "\n前缀[添加前缀(Y)/不加前缀(N)]<" (nth 4 ccvar)">:")))
(if (= k nil)(setq k (nth 4 ccvar)))
(setq s "" marks (nth 5 ccvar))
(if (= k "Y")
(progn
(setq s (getstring (strcat "\n设置前缀<" marks ">:")))
(if (= s "")(setq s marks)(setq marks s))
)
)
(if (= r nil)(setq r (car ccvar)))
(if (= h nil)(setq h (cadr ccvar)))
(if (= n nil)(setq n (caddr ccvar)))
(if (= b nil)(setq b (cadddr ccvar)))
(setq ccvar (list r h n b k marks))
(setq ss "" bb (itoa n))
(while (setq pt (getpoint "\n指定起点:"))
(setq ceo nil)
(repeat (- b (strlen bb)) (setq ss (strcat ss "0")))
(if (> r 0) (progn (command "circle" pt r) (setq ceo (entget (entlast)))))
(entmake(list '(0 . "text")'(50 . 0.0) (cons 10 pt)(cons 11 pt)(cons 1 (strcat s ss bb))(cons 40 h)'(6 . "Continuous")'(72 . 1)'(210 0.0 0.0 1.0)'(100 . "AcDbText")'(73 . 2)))
(setq teo (entget (entlast)))
(entmake (list '(0 . "LEADER")'(100 . "AcDbEntity")'(100 . "AcDbLeader")(cons 10 pt) (cons 10 (polar pt (* pi 0.25) r))))
(setq leo (entget (entlast)))
(setq p1 (cdr (assoc 10 leo)) k 1)
(while (/= k 3)
(setq p (grread T))
(setq k (car p) p (cadr p))
(if (> r 0)
(progn
(setq ceo (subst (cons 10 p) (assoc 10 ceo) ceo))
(entmod ceo)
)
)
(setq teo (subst (cons 11 p) (assoc 11 teo) teo))
(entmod teo)
(setq p (polar p (angle p p1) r))
(setq leo (subst (cons 10 p) (assoc 10 (reverse leo)) leo))
(if (> (distance p p1) 0.0) (entmod leo))
)
(setq n (1+ n) ss "" bb (itoa n))
)
(setvar "cmdecho" 1)
(princ)
)
(princ "\n命令:CC")
(princ) 飞雪神光 发表于 2024-4-9 14:21
替换这一段
(if (> (distance p p1) 0.0)
(progn
(entmod leo)
(vla-put-ArrowheadSize (Vlax-Ename->Vla-Object (cdar leo)) r)
)
)
你修改的代码，正好是我想要的，这一段好像应该这样改才合适 本帖最后由 飞雪神光 于 2024-4-9 14:22 编辑
huxu823 发表于 2024-4-9 13:17
感谢兄弟，试了一下，第一个BUG解决了，第二个还是老样子，引线的小圆点没有根据圆圈半径或者字高而放大 ...
替换这一段(if (> (distance p p1) 0.0)
(progn
(entmod leo)
(vla-put-ArrowheadSize (Vlax-Ename->Vla-Object lety) r)
)
) 飞雪神光 发表于 2024-4-9 11:38
感谢兄弟，试了一下，第一个BUG解决了，第二个还是老样子，引线的小圆点没有根据圆圈半径或者字高而放大相应的倍数 我给别人定制，多重引线自带反应器。你的单重引线，还没有反应器，限制太多了 Qwer1243 发表于 2024-5-2 21:21
你修改的代码，正好是我想要的，这一段好像应该这样改才合适
试了下，可以用，但是也有问题，如果当前的标注样式的全局比例假设是1:100的，标出来的引线反而看不见小圆点了！
要如何修改代码，才能让标注的引线小圆点不受当前标注样式的影响？
huxu823 发表于 2024-5-5 10:54
试了下，可以用，但是也有问题，如果当前的标注样式的全局比例假设是1:100的，标出来的引线反而看不见小 ...
会有影响吗，圆点的大小不是由你输入的圆大小确定的吗？
(if (= ccvar nil)(setq ccvar (list 2.5 3 1 1 "N" "")))
(setq r(getreal (strcat "\n圆圈半径<" (rtos (car ccvar)) ">:")))
从最开始，你的r就定死了 huxu823 发表于 2024-5-5 10:54
试了下，可以用，但是也有问题，如果当前的标注样式的全局比例假设是1:100的，标出来的引线反而看不见小 ...
我想了一下，你说得应该是全局标注比例，获取系统的比例参数乘上r应该就解决了
(if (> (distance p p1) 0.0)
(progn
(entmod leo)
(vla-put-ArrowheadSize (Vlax-Ename->Vla-Object (cdar leo)) (* r (getvar "DIMSCALE")))
)
) 本帖最后由 huxu823 于 2024-5-5 19:59 编辑
Qwer1243 发表于 2024-5-5 15:39
我想了一下，你说得应该是全局标注比例，获取系统的比例参数乘上r应该就解决了
我说的小圆点，不是指数字外的那个圆圈，是引线的箭头小圆点。
确实跟当前的全局比例有关，比如圆半径默认是2.5，字高默认是3，我输入的250和300，相当于放大了100倍，但是如果当前的全局比例是1，引线的小圆点箭头就会非常小，与字高不匹配。而此时我希望引线的小圆点的大小应该是放大了100倍的关系，相当于全局比例100时的小圆点的大小。
页:
[1]
2