[求助]ZZXXQQ，球标标注的问题。

小妹丁 发表于 2010-11-11 20:17:00

我写的一个球标标注，虽然难看点，用起来却自我感觉良好。
看了你在序号加一中的功能，想请你完整下。
目前，此程序，没有判断两个球标之间的距离，是否太近，可能导致球形重叠。我希望，当太近时，提示是否采用连球方式：如4、5、6三个球号相切，共用一条指引线，不是连球方式时，可重新选取位置，只要球标点分得足够远，连球方式就自行结束。

zst1978 发表于 2020-2-16 19:31:37

小妹丁发表于 2010-11-12 01:01
ZZXXQQ，连球方式如果能考虑进去，将是最好的的球标标注程序。很多人在这个球标标注上写得都没这个好用。
...

ZZXXQQ，连球方式如果能考虑进去，将是最好的的球标标注程序。很多人在这个球标标注上写得都没这个好用。
...

zhangrunze 发表于 2024-3-30 14:39:39

669423907 发表于 2011-10-7 21:48
再次感谢ZZXXQQ版
搞定了！
改成这样：

感谢分享~
显示如下：
命令: qqqq Error: AutoCAD 变量设置被拒绝: "clayer" "9标注"
也不清楚哪里的问题~

男人的诱惑 发表于 2018-8-10 22:30:10

ZZXXQQ：球标圆能不能改为可变，如果数值超过四位数时，数字就跑到圆外

小妹丁 发表于 2010-11-11 20:17:00

;;;球标，标注程序 ;;自动对齐，功能简单      ;测试版 (defun c:qub (/ os oldlayer pt num ppoint angleline texthight LINEL ss        ent)   (setq os (getvar "osmode"))   (setq ort (getvar "ORTHOMODE"))   (setq oldlayer (getvar "CLAYER"))   (command "_.undo" "be")   (setvar "osmode" 0)   (setvar "ORTHOMODE" 1)   (command "layer" "s" "标注" "")   (if (and (setq pt (getpoint "\n指定球标位置："))     (setq numx (getreal "\n起始序号："))       )     (progn       (setvar "ORTHOMODE" 0)       (setq ppoint (getpoint pt "\n标示构件点:"))       (setvar "ORTHOMODE" 1)       (setq angleline (angle ppoint pt))       (setq texthight (getvar 'textsize))       (SETQ LINEL (- (DISTance PPOINT PT) (* 1.0 texthight)))       (setq num (rtos numx 2 0))       (command "layer" "s" "文本" "")       (command "mtext" pt "J" "MC" "H" texthight "w" 8 NUM "")       (command "layer" "s" "粗实线" "")       (COMMAND "CIRCLE" PT (* 1.0 texthight))       (command "layer" "s" "标注" "")       (COMMAND "donut" 0 "0.5" ppoint "")       (COMMAND "LINE"         (POLAR PPOINT angleline 0.25)         (POLAR PPOINT angleline LINEL)         ""       )     )   )   (while (setq nextpoint (getpoint pt "\n下一个球标位置："))     (if (< (setq x_dist (abs (- (car nextpoint) (car pt))))     (setq y_dist (abs (- (cadr nextpoint) (cadr pt))))  )       (progn  (setq angle_point (* 0.5 pi))  (SETQ NUMx (+ NUMx 1))  (SETQ    PTX     (POLAR PT angle_point (- (CADR nextpoint) (CADR PT)))  )  (setvar "ORTHOMODE" 0)  (setq ppoint (getpoint ptx "\n标示构件点:"))  (setvar "ORTHOMODE" 1)  (setq angleline (angle ppoint ptX))  (SETQ LINEL (- (DISTance PPOINT PTX) (* 1.0 texthight)))  (setq num (rtos numx 2 0))  (command "layer" "s" "文本" "")  (command "mtext" ptX "J" "MC" "H" texthight "w" 8 NUM "")  (command "layer" "s" "粗实线" "")  (COMMAND "CIRCLE" PTX (* 1.0 texthight))  (command "layer" "s" "标注" "")  (COMMAND "donut" 0 "0.5" ppoint "")  (COMMAND "LINE"    (POLAR PPOINT angleline 0.25)    (POLAR PPOINT angleline LINEL)    ""  )  (setq pt ptx)       )       (PROGN  (SETQ ANGLE_POINT 0)  (SETQ NUMx (+ NUMx 1))  (SETQ    PTX     (POLAR PT angle_point (- (CAR nextpoint) (CAR PT)))  )  (setvar "ORTHOMODE" 0)  (setq ppoint (getpoint ptx "\n标示构件点:"))  (setvar "ORTHOMODE" 1)  (setq angleline (angle ppoint ptX))  (SETQ LINEL (- (DISTance PPOINT PTX) (* 1.0 texthight)))  (setq num (rtos numx 2 0))  (command "layer" "s" "文本" "")  (command "mtext" ptX "J" "MC" "H" texthight "w" 8 NUM "")  (command "layer" "s" "粗实线" "")  (COMMAND "CIRCLE" PTX (* 1.0 texthight))  (command "layer" "s" "标注" "")  (COMMAND "donut" 0 "0.5" ppoint "")  (COMMAND "LINE"    (POLAR PPOINT angleline 0.25)    (POLAR PPOINT angleline LINEL)    ""  )  (setq pt ptx)       )     )   )   (command "_.undo" "e")   (setvar "ORTHOMODE" ort)   (setvar "osmode" os)   (setvar "clayer" oldlayer)   (princ) ) (princ "***qub***测试版")

小妹丁 发表于 2010-11-11 21:01:00

另，第一次输入球标点时，如果直接结束会出错，没有容错处理。这一点，我忘记了。

ZZXXQQ 发表于 2010-11-11 23:06:00

加上容错，并简化了程序

(defun c:qub (/ os oldlayer pt num ppoint angleline texthight LINEL)
(setq os (getvar "osmode"))
(setq ort (getvar "ORTHOMODE"))
(setq oldlayer (getvar "CLAYER"))
(command "_.undo" "be")
(setvar "osmode" 0)
(setvar "ORTHOMODE" 1)
(command "layer" "s" "标注" "")
(if (and (setq pt (getpoint "\n指定球标位置："))
(setq numx (getreal "\n起始序号："))) (progn
(setvar "ORTHOMODE" 0)
(setq ppoint (getpoint pt "\n标示构件点:"))
(setvar "ORTHOMODE" 1)
(setq angleline (angle ppoint pt))
(setq texthight (getvar 'textsize))
(setq LINEL (- (distance PPOINT PT) (* 1.0 texthight)))
(setq num (rtos numx 2 0))
(setvar "CLAYER" "文本")
(command "mtext" pt "J" "MC" "H" texthight "w" 8 NUM "")
(setvar "CLAYER" "粗实线")
(command "CIRCLE" PT (* 1.0 texthight))
(setvar "CLYER" "标注")
(command "donut" 0 "0.5" ppoint "")
(command "LINE" (polar PPOINT angleline 0.25) (polar PPOINT angleline LINEL) "")
))
(if pt
(while (setq nextpoint (getpoint pt "\n下一个球标位置："))
(if (< (abs (- (car nextpoint) (car pt))) (abs (- (cadr nextpoint) (cadr pt))))
(setq angle_point (* 0.5 pi))
(setq angle_point 0)
)
(setq NUMx (+ NUMx 1))
(setq PTX (polar PT angle_point (- (cadr nextpoint) (cadr PT))))
(setvar "ORTHOMODE" 0)
(setq ppoint (getpoint ptx "\n标示构件点:"))
(setvar "ORTHOMODE" 1)
(setq angleline (angle ppoint ptX))
(setq LINEL (- (DISTance PPOINT PTX) (* 1.0 texthight)))
(setq num (rtos numx 2 0))
(setvar "CLAYER" "文本")
(command "mtext" ptX "J" "MC" "H" texthight "w" 8 NUM "")
(setvar "CLAYER" "粗实线")
(command "CIRCLE" PTX (* 1.0 texthight))
(setvar "CLYER" "标注")
(command "donut" 0 "0.5" ppoint "")
(command "LINE" (polar PPOINT angleline 0.25) (polar PPOINT angleline LINEL) "")
(setq pt ptx)
)
)
(command "_.undo" "e")
(setvar "ORTHOMODE" ort)
(setvar "osmode" os)
(setvar "clayer" oldlayer)
(princ)
)
(princ "***qub***测试版")
(princ)

qjcpj 发表于 2010-11-11 23:38:00

图形中无“标注”等图层时程序仍然出错，建议在程序中加判断，如无该图层时新建该图层。

小妹丁 发表于 2010-11-12 01:01:00

ZZXXQQ，连球方式如果能考虑进去，将是最好的的球标标注程序。很多人在这个球标标注上写得都没这个好用。
我写得乱，开始没考虑ORTHOMODE，后来为更直观才加的。

小妹丁 发表于 2010-11-12 01:03:00

qjcpj发表于2010-11-11 23:38:00static/image/common/back.gif图形中无“标注”等图层时程序仍然出错，建议在程序中加判断，如无该图层时新建该图层。

图层自己改好了，加多了图层也不是好事。

ZZXXQQ 发表于 2010-11-13 17:26:00

加上连球方式，并解决无图层问题。

(defun c:qub (/ os oldlayer pt num ppoint angleline texthight LINEL)
(setq os (getvar "osmode"))
(setq ort (getvar "ORTHOMODE"))
(setq oldlayer (getvar "CLAYER"))
(command "_.undo" "be")
(setvar "osmode" 0)
(setvar "ORTHOMODE" 1)
(if (and (setq numx (getreal "\n起始序号："))
(setq pt (getpoint "\n指定球标位置 :"))) (progn
(setvar "ORTHOMODE" 0)
(setq ppoint (getpoint pt "\n标示构件点 :"))
(setvar "ORTHOMODE" 1)
(setq angleline (angle ppoint pt))
(setq texthight (getvar 'textsize))
(setq LINEL (- (distance PPOINT PT) (* 1.0 texthight)))
(setq num (rtos numx 2 0))
(command "LAYER" "M" "文本" "")
(command "mtext" pt "J" "MC" "H" texthight "w" 8 NUM "")
(command "LAYER" "M" "粗实线" "")
(command "CIRCLE" PT (* 1.0 texthight))
(command "LAYER" "M" "标注" "")
(command "donut" 0 "0.5" ppoint "")
(command "LINE" (polar PPOINT angleline 0.25) (polar PPOINT angleline LINEL) "")
))
(if pt
(while (setq nextpoint (getpoint pt "\n下一个球标位置 :"))
(if (< (abs (- (car nextpoint) (car pt))) (abs (- (cadr nextpoint) (cadr pt))))
(setq ptx (list (car pt) (cadr nextpoint)))
(setq ptx (list (car nextpoint) (cadr pt)))
)
(if (equal (distance ptx pt) (* 2 texthight) texthight)
(setq ptx (polar pt (angle pt ptx) (* 2 texthight)))
)
(setq NUMx (1+ NUMx))
(setq num (rtos numx 2 0))
(command "LAYER" "M" "文本" "")
(command "mtext" ptX "J" "MC" "H" texthight "w" 8 NUM "")
(command "LAYER" "M" "粗实线" "")
(command "CIRCLE" PTX (* 1.0 texthight))
(if (not (equal (distance ptx pt) (* 2 texthight) texthight)) (progn
(setvar "ORTHOMODE" 0)
(setq ppoint (getpoint ptx "\n标示构件点 :"))
(setvar "ORTHOMODE" 1)
(command "LAYER" "M" "标注" "")
(command "donut" 0 "0.5" ppoint "")
(setq angleline (angle ppoint ptX))
(setq LINEL (- (DISTance PPOINT PTX) (* 1.0 texthight)))
(command "LINE" (polar PPOINT angleline 0.25) (polar PPOINT angleline LINEL) "")
))
(setq pt ptx)
)
)
(command "_.undo" "e")
(setvar "ORTHOMODE" ort)
(setvar "osmode" os)
(setvar "clayer" oldlayer)
(princ)
)
(princ "***qub***测试版")
(princ)

小妹丁 发表于 2010-11-13 23:51:00

ZZXXQQ，连球方式处理得非常好，虽然偶尔在引线上有些小不足（看上去有点不太顺），但确确实实好用了。
一处理图层，一大堆文字会让人疯掉，好在我还算能改掉它，哈。
MText: 命令: LAYER 当前图层:  文本 输入选项 [?/生成(M)/设置(S)/新建(N)/重命名(R)/开(ON)/关(OFF)/颜色(C)/线型(L)/线宽(LW)/透明度(TR)/材质(MAT)/打印(P )/冻结(F)/解冻(T)/锁定(LO)/解锁(U)/状态(A)/说明(D)/协调(E)]: M 输入新图层的名称 (成为当前图层) <文本>: 粗实线输入选项 [?/生成(M)/设置(S)/新建(N)/重命名(R)/开(ON)/关(OFF)/颜色(C)/线型(L)/线宽(LW)/透明度(TR)/材质(MAT)/打印(P )/冻结(F)/解冻(T)/锁定(LO)/解锁(U)/状态(A)/说明(D)/协调(E)]: 命令: CIRCLE 指定圆的圆心或 [三点(3P)/两点(2P)/切点、切点、半径(T)]: 指定圆的半径或 [直径(D)] <2.50>: 2.500000000000000 命令: 标示构件点 :LAYER 当前图层:  粗实线 输入选项 [?/生成(M)/设置(S)/新建(N)/重命名(R)/开(ON)/关(OFF)/颜色(C)/线型(L)/线宽(LW)/透明度(TR)/材质(MAT)/打印(P )/冻结(F)/解冻(T)/锁定(LO)/解锁(U)/状态(A)/说明(D)/协调(E)]: M 输入新图层的名称 (成为当前图层) <粗实线>: 标注输入选项 [?/生成(M)/设置(S)/新建(N)/重命名(R)/开(ON)/关(OFF)/颜色(C)/线型(L)/线宽(LW)/透明度(TR)/材质(MAT)/打印(P )/冻结(F)/解冻(T)/锁定(LO)/解锁(U)/状态(A)/说明(D)/协调(E)]: 命令: donut 指定圆环的内径 <0.00>: 0 指定圆环的外径 <0.50>: 0.5 指定圆环的中心点或 <退出>: 指定圆环的中心点或 <退出>: 命令: LINE 指定第一点: 指定下一点或 [放弃(U)]: 指定下一点或 [放弃(U)]: 命令: 下一个球标位置 :LAYER 当前图层:  标注 输入选项 [?/生成(M)/设置(S)/新建(N)/重命名(R)/开(ON)/关(OFF)/颜色(C)/线型(L)/线宽(LW)/透明度(TR)/材质(MAT)/打印(P )/冻结(F)/解冻(T)/锁定(LO)/解锁(U)/状态(A)/说明(D)/协调(E)]: M 输入新图层的名称 (成为当前图层) <标注>: 文本输入选项 [?/生成(M)/设置(S)/新建(N)/重命名(R)/开(ON)/关(OFF)/颜色(C)/线型(L)/线宽(LW)/透明度(TR)/材质(MAT)/打印(P )/冻结(F)/解冻(T)/锁定(LO)/解锁(U)/状态(A)/说明(D)/协调(E)]: 命令: mtext 当前文字样式:  "中文"  文字高度:  2.5  注释性:  否 指定第一角点: 指定对角点或 [高度(H)/对正(J)/行距(L)/旋转(R)/样式(S)/宽度(W)/栏(C)]: J 输入对正方式 [左上(TL)/中上(TC)/右上(TR)/左中(ML)/正中(MC)/右中(MR)/左下(BL)/中下(BC)/右下(BR)] <左上(TL)>: MC 指定对角点或 [高度(H)/对正(J)/行距(L)/旋转(R)/样式(S)/宽度(W)/栏(C)]: H 指定高度 <2.5>: 2.500000000000000 指定对角点或 [高度(H)/对正(J)/行距(L)/旋转(R)/样式(S)/宽度(W)/栏(C)]: w 指定宽度: 8 MText: 14 MText: 命令: LAYER 当前图层:  文本 输入选项 [?/生成(M)/设置(S)/新建(N)/重命名(R)/开(ON)/关(OFF)/颜色(C)/线型(L)/线宽(LW)/透明度(TR)/材质(MAT)/打印(P )/冻结(F)/解冻(T)/锁定(LO)/解锁(U)/状态(A)/说明(D)/协调(E)]: M 输入新图层的名称 (成为当前图层) <文本>: 粗实线输入选项 [?/生成(M)/设置(S)/新建(N)/重命名(R)/开(ON)/关(OFF)/颜色(C)/线型(L)/线宽(LW)/透明度(TR)/材质(MAT)/打印(P )/冻结(F)/解冻(T)/锁定(LO)/解锁(U)/状态(A)/说明(D)/协调(E)]: 命令: CIRCLE 指定圆的圆心或 [三点(3P)/两点(2P)/切点、切点、半径(T)]: 指定圆的半径或 [直径(D)] <2.50>: 2.500000000000000 命令: 标示构件点 :LAYER 当前图层:  粗实线 输入选项 [?/生成(M)/设置(S)/新建(N)/重命名(R)/开(ON)/关(OFF)/颜色(C)/线型(L)/线宽(LW)/透明度(TR)/材质(MAT)/打印(P )/冻结(F)/解冻(T)/锁定(LO)/解锁(U)/状态(A)/说明(D)/协调(E)]: M 输入新图层的名称 (成为当前图层) <粗实线>: 标注输入选项 [?/生成(M)/设置(S)/新建(N)/重命名(R)/开(ON)/关(OFF)/颜色(C)/线型(L)/线宽(LW)/透明度(TR)/材质(MAT)/打印(P )/冻结(F)/解冻(T)/锁定(LO)/解锁(U)/状态(A)/说明(D)/协调(E)]: 命令: donut 指定圆环的内径 <0.00>: 0 指定圆环的外径 <0.50>: 0.5 指定圆环的中心点或 <退出>: 指定圆环的中心点或 <退出>: 命令: LINE 指定第一点: 指定下一点或 [放弃(U)]: 指定下一点或 [放弃(U)]: 命令: 下一个球标位置 :LAYER 当前图层:  标注 输入选项 [?/生成(M)/设置(S)/新建(N)/重命名(R)/开(ON)/关(OFF)/颜色(C)/线型(L)/线宽(LW)/透明度(TR)/材质(MAT)/打印(P )/冻结(F)/解冻(T)/锁定(LO)/解锁(U)/状态(A)/说明(D)/协调(E)]: M 输入新图层的名称 (成为当前图层) <标注>: 文本输入选项 [?/生成(M)/设置(S)/新建(N)/重命名(R)/开(ON)/关(OFF)/颜色(C)/线型(L)/线宽(LW)/透明度(TR)/材质(MAT)/打印(P )/冻结(F)/解冻(T)/锁定(LO)/解锁(U)/状态(A)/说明(D)/协调(E)]: 命令: mtext 当前文字样式:  "中文"  文字高度:  2.5  注释性:  否 指定第一角点: 指定对角点或 [高度(H)/对正(J)/行距(L)/旋转(R)/样式(S)/宽度(W)/栏(C)]: J 输入对正方式 [左上(TL)/中上(TC)/右上(TR)/左中(ML)/正中(MC)/右中(MR)/左下(BL)/中下(BC)/右下(BR)] <左上(TL)>: MC 指定对角点或 [高度(H)/对正(J)/行距(L)/旋转(R)/样式(S)/宽度(W)/栏(C)]: H 指定高度 <2.5>: 2.500000000000000 指定对角点或 [高度(H)/对正(J)/行距(L)/旋转(R)/样式(S)/宽度(W)/栏(C)]: w 指定宽度: 8 MText: 15

小妹丁 发表于 2010-11-13 23:54:00

图上5和14，只能手工改在7和17出线。

页: [1] 2 3 4

明经CAD社区's Archiver

[求助]ZZXXQQ，球标标注的问题。