muai2010 发表于 2024-8-4 23:49
有重叠线，多余线，文字没居中，其他还不错哈
我尽量减少重叠线了，文字应该是居中的啊
本帖最后由 muai2010 于 2024-8-5 00:24 编辑
jackAqwq 发表于 2024-8-4 23:51
我尽量减少重叠线了，文字应该是居中的啊
我加载了两个，冲突了，再测试没大问题，可以把竖线弄成一条，不然要画好多直线
muai2010 发表于 2024-8-5 00:15
我加载了两个，冲突了，再测试没大问题，可以把竖线弄成一条，不然要画好多直线，上个图
不对，应该是没有重叠线，都是一段段画的直线，我也不会怎么生成完后给这些合并
jackAqwq 发表于 2024-8-5 00:24
不对，应该是没有重叠线，都是一段段画的直线，我也不会怎么生成完后给这些合并
已经很不错了，用起来还不错，感谢分享
本帖最后由 jackAqwq 于 2024-8-5 01:55 编辑
muai2010 发表于 2024-8-5 00:25
已经很不错了，用起来还不错，感谢分享
这个好像能快点
(vl-load-com)
(defun c:ZBB(/ *error* BGZGentss ss1 apt1 apt2 apt3 apt4 BGHG apt1Y apt1X DHQZ i DH pt1 ptdh )
;(K:SysVar);修改系统变量
;(command "_undo" "be")
(defun *error* (msg);错误处理
(setvar "regenmode" 1)
;;(command "undo" "e")
;;(setvar "cmdecho" 1)
(setvar "DimZin" 1);不消0
(vla-endundomark adoc)
(princ msg)
)
(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
(vla-startundomark adoc)
(setvar "regenmode" 0);停止自刷新
(setvar "DimZin" 1);数值不消0
;(setvar "TextStyle" LENGTH);数值不消0
(setvar "OSMode" 0);数值不消0
;;;程序加载初始化设置
(if (=nil)
(setq BGZG 2.0) ;文字高度
)
(if (= BGMC nil)
(setq BGMC "人防工程坐标表") ;表格名称
)
(if (= DHQZ nil)
(setq DHQZ "F") ;点号前缀
)
(if (= XY-YX nil)
(setq XY-YX "是") ;交换X Y坐标标记
)
(progn
(princ "\n当前参数值文字高度：")
(princ BGZG)
(princ "表格名称：")
(princ BGMC)
(princ "点号前缀：")
(princ DHQZ)
(princ "交换坐标：")
(princ XY-YX)
)
(setq ent (ssname (ssget) 0))
(setq ss (plgetlsta1ent))
(setq ss1 ss)
;;;指定需标注的点或设置字高、比例、精度、交换X Y坐标
(setq apt1 nil)
(while (= apt1 nil)
(initget "1 2 3 4")
(setq apt1 (getpoint
"\n表格位置 或 [字高(1)/表格名称(2)/点号前缀(3)/交换坐标(4)]:"
)
)
(cond
((= apt1 "1")
(setq apt1 nil
BGZG_old BGZG
)
(setq BGZG (getreal (strcat "\n指定字高<" (rtos BGZG 2) ">：")))
(if (= BGZG nil) (setq BGZG BGZG_old))
(princ (strcat "当前字高：" (rtos BGZG 2)))
)
((= apt1 "2")
(setq apt1 nil
BGMC_old BGMC
)
(setq BGMC (getstring (strcat "\n表格名称<"BGMC">：")))
(if (= BGMC nil) (setq BGMC BGMC_old))
(princ (strcat "当前表名：" BGMC))
)
((= apt1 "3")
(setq apt1 nil
DHQZ_old DHQZ
)
(setq DHQZ (getstring(strcat "\n指定前缀<" DHQZ ">：")))
(if (= DHQZ nil) (setq DHQZ DHQZ_old))
(princ (strcat "当前前缀：" DHQZ))
)
((= apt1 "4")
(setq apt1 nil)
(initget 1 "1 2")
(setq XY-YX (getkword (strcat "\n是否交换坐标[是(1)/否(2)]<" XY-YX ">：")))
(princ
(strcat
"当前交换坐标："
(cond
((= XY-YX "1") "是")
((= XY-YX "2") "否")
)
)
)
)
(T)
)
)
(NewLayer:Name-YanSe BGMC 1)
(setq BGHG (* 3 BGZG));BGHG:表格行高
(setq apt2 (polar apt1 0 (* BGZG 20 )));第一行宽：字高*20
(setq apt3 (polar apt2 (* pi 1.5) BGHG))
(setq apt4 (polar apt1 (* pi 1.5) BGHG))
;(command "_LAYER" "M" BGMC "C" "1" BGMC "");生成图层并设置颜色
;(NewLine:pt1-pt2 apt1 apt4);表头框左边那一行直线
;(NewLine:pt1-pt2 apt1 apt2);表头框上面那一行直线
;(NewLine:pt1-pt2 apt2 apt3);表头框右边那一行直线
;表头框,上面注释掉就不显示表头框
(NewLine:pt1-pt2 apt3 apt4);表头框下面那一行直线
(setq apt1Y (polar apt1 (* pi 1.5) (/ BGHG 2)));
(setq apt1X (polar apt1Y 0 (/ (* BGZG 20)2)));0 16
(NewText:JiDian-NeiRong-ZiGao apt1X "人防工程坐标表" (* 1.2 BGZG) )
(setq i 1)
( BGCS BGZG iapt4 0 )
(repeat (length ss)
( setq apt4 (polar apt4 (* pi 1.5) BGHG))
( setq DH(strcat DHQZ (itoa i) ));点号名称
( setq pt1 (car ss1));点号列表
( setq ptdh (polar pt1 (* pi 0.5) (* 1.25 BGZG )));点号位置
(NewText:JiDian-NeiRong-ZiGao ptdh DH (* 1.0 BGZG ) );顶点生成点号的参数
;( command "text" "MC" ptdh (* 1.0 BGZG )0 DH )
(NewCIRCLE:PT-BJ pt1 (* 0.12 BGZG));顶点生成圆的参数
;( command ".CIRCLE" pt1 (* 0.12 BGZG) );圈大小
( setq ss1(cdr ss1))
( BGCS BGZG DHapt4pt1 )
( setq i (1+ i))
)
;(command "_undo" "e")
;(setvar "regenmode" 1)
; (command "regen")
(vla-endundomark adoc)
(setvar "OSMode" 147);数值不消0
;(K:SysVar);恢复系统变量
(princ)
)
;以下是相应函数
;表格参数
(defun BGCS ( BGZG iptptzb / w hpta pta1 pta2pta3)
(setq w (* BGZG 4));列宽
(setq h (* BGZG 3));行高
(NewLine:pt1-pt2 pt (polar pt (* pi 1.5) h));第1列
(NewLine:pt1-pt2 (polar pt (* pi 1.5) h) (polar (polar pt 0 (* w 5)) (* pi 1.5) h));第2行
(NewLine:pt1-pt2 (polar (polar pt 0 (* w 5)) (* pi 1.5) h) (polar pt 0 (* w 5)));第4列
(NewLine:pt1-pt2 (polar pt 0 w) (polar (polar pt 0 w) (* pi 1.5) h));第2列
(NewLine:pt1-pt2 (polar pt 0 (* w 3)) (polar (polar pt 0 (* w 3)) (* pi 1.5) h));第3列
(setq pta (polar pt (* pi 1.5) (* h 0.5)));行高中点
(setq pta1 (polar pta 0 (* w 0.5)));点号列宽中点
(setq pta2 (polar pta 0 (* W 2)));X列宽中点
(setq pta3 (polar pta 0 (* W 4)));Y列宽中点
( if (= ptzb 0)
(progn
(NewText:JiDian-NeiRong-ZiGao pta1 "点号" (* 1.2 BGZG))
(NewText:JiDian-NeiRong-ZiGao pta2 "X" (* 1.2 BGZG))
(NewText:JiDian-NeiRong-ZiGao pta3 "Y" (* 1.2 BGZG))
)
(progn
(if (= XY-YX "2")
(setq X (rtos (cadr ptzb) 2 2)
Y (rtos (car ptzb) 2 2)
)
(setq Y (rtos (cadr ptzb) 2 2)
X (rtos (car ptzb) 2 2)
)
)
(NewText:JiDian-NeiRong-ZiGao pta1 i BGZG)
(NewText:JiDian-NeiRong-ZiGao pta2 Y BGZG)
(NewText:JiDian-NeiRong-ZiGao pta3 X BGZG)
)
)
)
(defun plgetlsta1 (ent)
(mapcar 'cdr (vl-remove-if-not (FUNCTION (LAMBDA (x) (= 10 (car x)))) (entget ent)))
)
;; 创建直线图元
(defun NewLine:pt1-pt2 (pt1 pt2)
(entmake (list '(0 . "LINE")
(cons 10 pt1)
(cons 11 pt2)
)
)
)
;; 创建文字图元
;; 基点-内容-字高
(defun NewText:JiDian-NeiRong-ZiGao (JiDian NeiRong ZiGao )
(entmake
(list
'(0 . "TEXT")
(cons 10 JiDian); 插入点
(cons 40 ZiGao); 文字高度
(cons 1 NeiRong); 文字内容
'(7 . "宋体");字形名称
'(72 . 1);水平对齐方式
'(73 . 2) ;垂直对齐方式
(cons 11 JiDian); 对齐插入点
)
))
;;创建图层函数
;;图名-颜色
(defun NewLayer:Name-YanSe (Name YanSe )
(if (not (tblsearch "LAYER" Name));;;判断有没有该图层
(entmake
(list
'(0 . "LAYER")
'(100 . "AcDbSymbolTableRecord")
'(100 . "AcDbLayerTableRecord")
'(70 . 0);层可见性
(cons 2 Name);图层名称
(cons 62 yanse) ;图层颜色
)
)
)
(setvar "CLAYER" Name)
)
;; 创建圆
;; 圆心-半径
(defun NewCIRCLE:PT-BJ (pt bj)
(entmakex
(list
(cons 0 "CIRCLE")
(cons 10 pt)
(cons 40 bj)
)
))
(princ)
jackAqwq 发表于 2024-8-5 01:39
这个好像能快点
太晚有一处没改到，帮你改下
(vl-load-com)
(defun c:ZBB(/ *error* BGZGentss ss1 apt1 apt2 apt3 apt4 BGHG apt1Y apt1X DHQZ i DH pt1 ptdh )
;(K:SysVar);修改系统变量
;(command "_undo" "be")
(defun *error* (msg);错误处理
(setvar "regenmode" 1)
;;(command "undo" "e")
;;(setvar "cmdecho" 1)
(setvar "DimZin" 1);不消0
(vla-endundomark adoc)
(princ msg)
)
(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
(vla-startundomark adoc)
(setvar "regenmode" 0);停止自刷新
(setvar "DimZin" 1);数值不消0
;(setvar "TextStyle" LENGTH);数值不消0
(setvar "OSMode" 0);数值不消0
;;;程序加载初始化设置
(if (=nil)
(setq BGZG 2.0) ;文字高度
)
(if (= BGMC nil)
(setq BGMC "人防工程坐标表") ;表格名称
)
(if (= DHQZ nil)
(setq DHQZ "F") ;点号前缀
)
(if (= XY-YX nil)
(setq XY-YX "是") ;交换X Y坐标标记
)
(progn
(princ "\n当前参数值文字高度：")
(princ BGZG)
(princ "表格名称：")
(princ BGMC)
(princ "点号前缀：")
(princ DHQZ)
(princ "交换坐标：")
(princ XY-YX)
)
(setq ent (ssname (ssget) 0))
(setq ss (plgetlsta1ent))
(setq ss1 ss)
;;;指定需标注的点或设置字高、比例、精度、交换X Y坐标
(setq apt1 nil)
(while (= apt1 nil)
(initget "1 2 3 4")
(setq apt1 (getpoint
"\n表格位置 或 [字高(1)/表格名称(2)/点号前缀(3)/交换坐标(4)]:"
)
)
(cond
((= apt1 "1")
(setq apt1 nil
BGZG_old BGZG
)
(setq BGZG (getreal (strcat "\n指定字高<" (rtos BGZG 2) ">：")))
(if (= BGZG nil) (setq BGZG BGZG_old))
(princ (strcat "当前字高：" (rtos BGZG 2)))
)
((= apt1 "2")
(setq apt1 nil
BGMC_old BGMC
)
(setq BGMC (getstring (strcat "\n表格名称<"BGMC">：")))
(if (= BGMC nil) (setq BGMC BGMC_old))
(princ (strcat "当前表名：" BGMC))
)
((= apt1 "3")
(setq apt1 nil
DHQZ_old DHQZ
)
(setq DHQZ (getstring(strcat "\n指定前缀<" DHQZ ">：")))
(if (= DHQZ nil) (setq DHQZ DHQZ_old))
(princ (strcat "当前前缀：" DHQZ))
)
((= apt1 "4")
(setq apt1 nil)
(initget 1 "1 2")
(setq XY-YX (getkword (strcat "\n是否交换坐标[是(1)/否(2)]<" XY-YX ">：")))
(princ
(strcat
"当前交换坐标："
(cond
((= XY-YX "1") "是")
((= XY-YX "2") "否")
)
)
)
)
(T)
)
)
(NewLayer:Name-YanSe BGMC 1)
(setq BGHG (* 3 BGZG));BGHG:表格行高
(setq apt2 (polar apt1 0 (* BGZG 20 )));第一行宽：字高*20
(setq apt3 (polar apt2 (* pi 1.5) BGHG))
(setq apt4 (polar apt1 (* pi 1.5) BGHG))
;(command "_LAYER" "M" BGMC "C" "1" BGMC "");生成图层并设置颜色
;(NewLine:pt1-pt2 apt1 apt4);表头框左边那一行直线
;(NewLine:pt1-pt2 apt1 apt2);表头框上面那一行直线
;(NewLine:pt1-pt2 apt2 apt3);表头框右边那一行直线
;表头框,上面注释掉就不显示表头框
(NewLine:pt1-pt2 apt3 apt4);表头框下面那一行直线
(setq apt1Y (polar apt1 (* pi 1.5) (/ BGHG 2)));
(setq apt1X (polar apt1Y 0 (/ (* BGZG 20)2)));0 16
(NewText:JiDian-NeiRong-ZiGao apt1X BGMC (* 1.2 BGZG) )
(setq i 1)
( BGCS BGZG iapt4 0 )
(repeat (length ss)
( setq apt4 (polar apt4 (* pi 1.5) BGHG))
( setq DH(strcat DHQZ (itoa i) ));点号名称
( setq pt1 (car ss1));点号列表
( setq ptdh (polar pt1 (* pi 0.5) (* 1.25 BGZG )));点号位置
(NewText:JiDian-NeiRong-ZiGao ptdh DH (* 1.0 BGZG ) );顶点生成点号的参数
;( command "text" "MC" ptdh (* 1.0 BGZG )0 DH )
(NewCIRCLE:PT-BJ pt1 (* 0.12 BGZG));顶点生成圆的参数
;( command ".CIRCLE" pt1 (* 0.12 BGZG) );圈大小
( setq ss1(cdr ss1))
( BGCS BGZG DHapt4pt1 )
( setq i (1+ i))
)
;(command "_undo" "e")
;(setvar "regenmode" 1)
; (command "regen")
(vla-endundomark adoc)
(setvar "OSMode" 147);数值不消0
;(K:SysVar);恢复系统变量
(princ)
)
;以下是相应函数
;表格参数
(defun BGCS ( BGZG iptptzb / w hpta pta1 pta2pta3)
(setq w (* BGZG 4));列宽
(setq h (* BGZG 3));行高
(NewLine:pt1-pt2 pt (polar pt (* pi 1.5) h));第1列
(NewLine:pt1-pt2 (polar pt (* pi 1.5) h) (polar (polar pt 0 (* w 5)) (* pi 1.5) h));第2行
(NewLine:pt1-pt2 (polar (polar pt 0 (* w 5)) (* pi 1.5) h) (polar pt 0 (* w 5)));第4列
(NewLine:pt1-pt2 (polar pt 0 w) (polar (polar pt 0 w) (* pi 1.5) h));第2列
(NewLine:pt1-pt2 (polar pt 0 (* w 3)) (polar (polar pt 0 (* w 3)) (* pi 1.5) h));第3列
(setq pta (polar pt (* pi 1.5) (* h 0.5)));行高中点
(setq pta1 (polar pta 0 (* w 0.5)));点号列宽中点
(setq pta2 (polar pta 0 (* W 2)));X列宽中点
(setq pta3 (polar pta 0 (* W 4)));Y列宽中点
( if (= ptzb 0)
(progn
(NewText:JiDian-NeiRong-ZiGao pta1 "点号" (* 1.2 BGZG))
(NewText:JiDian-NeiRong-ZiGao pta2 "X" (* 1.2 BGZG))
(NewText:JiDian-NeiRong-ZiGao pta3 "Y" (* 1.2 BGZG))
)
(progn
(if (= XY-YX "2")
(setq X (rtos (cadr ptzb) 2 2)
Y (rtos (car ptzb) 2 2)
)
(setq Y (rtos (cadr ptzb) 2 2)
X (rtos (car ptzb) 2 2)
)
)
(NewText:JiDian-NeiRong-ZiGao pta1 i BGZG)
(NewText:JiDian-NeiRong-ZiGao pta2 Y BGZG)
(NewText:JiDian-NeiRong-ZiGao pta3 X BGZG)
)
)
)
(defun plgetlsta1 (ent)
(mapcar 'cdr (vl-remove-if-not (FUNCTION (LAMBDA (x) (= 10 (car x)))) (entget ent)))
)
;; 创建直线图元
(defun NewLine:pt1-pt2 (pt1 pt2)
(entmake (list '(0 . "LINE")
(cons 10 pt1)
(cons 11 pt2)
)
)
)
;; 创建文字图元
;; 基点-内容-字高
(defun NewText:JiDian-NeiRong-ZiGao (JiDian NeiRong ZiGao )
(entmake
(list
'(0 . "TEXT")
(cons 10 JiDian); 插入点
(cons 40 ZiGao); 文字高度
(cons 1 NeiRong); 文字内容
'(7 . "宋体");字形名称
'(72 . 1);水平对齐方式
'(73 . 2) ;垂直对齐方式
(cons 11 JiDian); 对齐插入点
)
))
;;创建图层函数
;;图名-颜色
(defun NewLayer:Name-YanSe (Name YanSe )
(if (not (tblsearch "LAYER" Name));;;判断有没有该图层
(entmake
(list
'(0 . "LAYER")
'(100 . "AcDbSymbolTableRecord")
'(100 . "AcDbLayerTableRecord")
'(70 . 0);层可见性
(cons 2 Name);图层名称
(cons 62 yanse) ;图层颜色
)
)
)
(setvar "CLAYER" Name)
)
;; 创建圆
;; 圆心-半径
(defun NewCIRCLE:PT-BJ (pt bj)
(entmakex
(list
(cons 0 "CIRCLE")
(cons 10 pt)
(cons 40 bj)
)
))
(princ)
寒潮大冬瓜 发表于 2024-8-3 23:59
DFB二、三维顶点编号→自动字高+自动通过多段线顶点数量确定补齐位数00格式+自动图层名嵌套→波总指导升级 ...
提示错误，用不了哦
jackAqwq 发表于 2024-8-5 20:40
提示错误，用不了哦
我发到另外一台电脑试过ok的哟！提示错误具体内容是什么样的呢？发上来看看？不能让你白费心思……
寒潮大冬瓜 发表于 2024-8-5 23:57
我发到另外一台电脑试过ok的哟！提示错误具体内容是什么样的呢？发上来看看？不能让你白费心思……
; 错误: no function definition: LSP20230905
jackAqwq 发表于 2024-8-6 09:47
; 错误: no function definition: LSP20230905
sp20230905可用于图元随机颜色在255内的随数生成自定义函数画图的时候可以让界面都是彩色的文字或线条.