非常感谢二楼的这位同仁，在百忙中回复了帖子。不过就是程序还是运行不正常。
你试试在程序开始加:
(setq ad (getvar 'angdir))
(setvar 'angdir 1)
末尾加:
(if ad (setvar 'angdir ad))
还有就是你这样直接建楼，别人看不见你的回复 clinber 发表于 2019-7-10 08:28
没搞懂这样加框有什么好处
这个是做建筑设计中的结构专业要用到的，配筋都是按预置设定的，加上框以后，可以提醒自己这里的箍筋要变大些，要不楼房的梁会有危险。 本帖最后由 1291500406 于 2019-7-10 11:56 编辑
涛涛_1048 发表于 2019-7-9 18:41
6楼的必强同学，在论坛里看到你写了好多程序，尤其是在工具箱方面，请必强同学也写一下吧。
(defun c:bb( / bbset bb b bb5 bb4 bb2ss i en max maxa min mina)(vl-load-com)
(setq bbset(getreal"\n必强提示输入设定值")bb(ssget ":s" '((0 . "text")(1 . "G*-*"))) b -1 i -1 bb5 (ssadd))
(repeat (sslength bb)(setq b (1+ b) bb4 (ssname bb b) bb2 (cdr(assoc 1 (entget bb4))))
(if(or(< bbset (atof(substr bb2 2 3)))(< bbset (atof(substr bb2 7 2))))(setq ss (ssadd bb4 bb5))))
(repeat (sslength ss) (setq en (ssname ss (setq i(+ i 1))))(vla-getboundingbox (vlax-ename->vla-object en) 'a 'b)
(setq max (vlax-safearray->list a) min (vlax-safearray->list b))(setq maxa (list (car max)(cadr min)) mina (list (car min)(cadr max)))
(entmakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity")'(100 . "AcDbPolyline") '(62 . 7) '(90 . 12) (cons 10 max) '(40 . 0) '(41 . 0)
(cons 10 max)(cons 62 2)(cons 8 "文字框")(cons 10 maxa)(cons 10 min)(cons 10 mina)(cons 10 max))))(princ))
涛涛_1048 发表于 2019-7-10 09:03
这个是做建筑设计中的结构专业要用到的，配筋都是按预置设定的，加上框以后，可以提醒自己这里的箍筋要变 ...
不如用批注功能 涛涛_1048 发表于 2019-7-10 09:03
这个是做建筑设计中的结构专业要用到的，配筋都是按预置设定的，加上框以后，可以提醒自己这里的箍筋要变 ...
意思是每个箍筋都提醒？ clinber 发表于 2019-7-10 21:10
意思是每个箍筋都提醒？
不是每个都提醒，是超过设定值的才提醒。 谢谢必强同学，用你提供的程序已经成功了。刚开始提示赋值给了系统保护的名称，两个max和min，就把max改成了maxx，min改成了minn，运行非常成功。看了必强同学的程序，把我原来输入数据的地方给简化了，原来要输入“G*-*”,现在就只输入一个数值就行了，简化了不少。 涛涛_1048 发表于 2019-7-10 22:19
不是每个都提醒，是超过设定值的才提醒。
哦哦哦 那还不如直接显示红色 1291500406 发表于 2019-7-10 10:11
(defun c:bb( / bbset bb b bb5 bb4 bb2ss i en max maxa min mina)(vl-load-com)
(setq bbset(ge ...
必强大侠这个文字不能是非正交的 ;;;文字边框
(defun get-mtextbox
(en txtsize BoxType / txtEntData PtTL xWidth xHeight xAngle Pt_TC PtTR PtTR Pt_BL Pt_BC Pt_BR Pt_MC)
(setq txtEntData (entget en))
(setq PtTL (cdr (assoc 10 txtEntData))
xWidth (cdr (assoc 42 txtEntData))
xHeight (cdr (assoc 43 txtEntData))
xAngle (cdr (assoc 50 txtEntData))
Pt_TC (polar PtTL xAngle (* xWidth 0.5))
PtTR (polar PtTL xAngle xWidth)
Pt_BL (polar PtTL (- xAngle (/ PI 2.0)) xHeight)
Pt_BC (polar Pt_BL xAngle (* xWidth 0.5))
Pt_BR (polar Pt_BL xAngle xWidth)
Pt_MC (polar Pt_BL
(angle Pt_BL PtTR)
(/ (distance Pt_BL PtTR) 2.0)
)
) ;endsetq
;(setq xAngle (cdr (assoc 50 txtEntData)))
(setq Pt_BL (polar Pt_BL xAngle (- txtsize)))
(setq Pt_BL (polar Pt_BL (+ xAngle (/ PI 2.0)) (- txtsize)))
(setq Pt_BR (polar Pt_BR xAngle txtsize))
(setq Pt_BR (polar Pt_BR (+ xAngle (/ PI 2.0)) (- txtsize)))
(setq PtTL (polar PtTL xAngle (- txtsize)))
(setq PtTL (polar PtTL (+ xAngle (/ PI 2.0)) txtsize))
(setq PtTR (polar PtTR xAngle txtsize))
(setq PtTR (polar PtTR (+ xAngle (/ PI 2.0)) txtsize))
(cond
;((= BoxType "C")(vl-cmdf "_Circle" Pt_MC (+ (/ (max (cadadr pt)(caadr pt)) 2.0) txtsize)))
((= BoxType "C")(vl-cmdf "_Circle" Pt_MC (/ (distance Pt_BL PtTR) 2.0)))
((= BoxType "R")(vl-cmdf "_PLine" Pt_BL Pt_BR PtTR PtTL "C"))
((= BoxType "S")(vl-cmdf "_PLine" Pt_BL Pt_BR "a" PtTR "l" PtTL "a""Cl"))
);COND
)
;text
(defun get-textbox (en offset / pt1 pt2 pt3 pt4 a b c d PT pts end pt_mc)
;(setq en (car (entsel)))
;(setq offset 1)
(setq end (entget en))
(setq pts (cdr (assoc 10 end)))
(setq a (cdr (assoc 50 end)))
(setq b (* (/ PI 180) 225))
(SETQ C (+ A B))
(setq d (sqrt (+ (* offset offset) (* offset offset))))
(setq pt (textbox end))
(setq pt1 (polar pts c d))
(setq b (* (/ PI 180) 45))
(SETQ C (+ A B))
(setq pt2 (polar pt1 a (+ (caadr pt) offset offset)))
(setq pt3 (polar pt2 (+ a (* pi 0.5)) (+ (cadadr pt) offset offset)))
(setq pt4 (polar pt1 (+ a (* pi 0.5)) (+ (cadadr pt) offset offset)))
(setq pt_mc (polar pt1 (angle Pt1 Pt3) (/ (distance Pt1 Pt3) 2.0)))
(cond
;((= BoxType "C")(vl-cmdf "_Circle" Pt_MC (+ (/ (max (cadadr pt)(caadr pt)) 2.0) txtsize)))
((= BoxType "C")(vl-cmdf "_Circle" Pt_MC (/ (distance Pt1 Pt3) 2.0)))
((= BoxType "R")(command "pline" pt1 pt2 pt3 pt4 "c"))
((= BoxType "S")(command "pline" pt1 pt2"A" pt3"L" pt4 "A""cL"))
);COND
)
(princ "\n 使用命令: wzbk")
(defun c:wzbk (/ cmd0 osmode0 ss s seconds s n nn en endata txtEntType txtsize)
(PRINC "\n【阳羡刚刚好CAD外挂<文字边框功能>】---给所选文字加上圆框/椭圆框/矩形框")(PRINC)
(setq cmd0 (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq osmode0 (getvar "OSMODE"));捕捉
(setvar "OSMODE" 0);捕捉
(vl-cmdf "_.undo" "_be")
(if (not #AY_TBOXBOXTYPE)(setq #AY_TBOXBOXTYPE "S"))
(initget "C S R")
(setq BoxType (getkword (strcat "\n边框类型 [圆形(C)/圆矩形(S)/矩形(R)]<" #AY_TBOXBOXTYPE ">: ")))
(if (= BoxType nil) (setq BoxType #AY_TBOXBOXTYPE) (setq #AY_TBOXBOXTYPE BoxType))
(if (setq ss (ssget '((0 . "*TEXT"))))
(progn
(setq s (getvar "DATE"))
(setq seconds (* 86400.0 (- s (fix s))))
(setq n 0);setq
(setq nn (sslength ss))
(repeat nn
(setq en (ssname ss n));setq
(setq endata (entget en))
(setq txtEntType (cdr (assoc 0 endata)))
(setq txtsize (cdr (assoc 40 endata)))
(setq txtsize (* (/ txtsize 2.5) 0.6))
(if (= txtEntType "TEXT")(get-textbox en txtsize));IF
(if (= txtEntType "MTEXT")(get-mtextbox en txtsize BoxType));IF
(setq n (1+ n))
(SETVAR "MODEMACRO" (strcat "** 已完成 "(rtos (* 100 (/ (+ 0.01 n) nn)) 2 0) "% **"))
);repeat
(setq s (getvar "DATE"))
(setq seconds2 (* 86400.0 (- s (fix s))))
(princ (strcat "\n 文字加框完成共耗时" (rtos (- seconds2 seconds) 2 3)"秒"))
);progn
(princ "\n没有选定有效的对象.")
);if
(vl-cmdf "_.undo" "_e")
(SETVAR "MODEMACRO" "")
(setvar "cmdecho" cmd0)
(setvar "OSMODE" osmode0)
(princ)
)
借花献佛
页:
1
[2]