橡皮 发表于 2024-7-3 15:54
哈哈，你舅惯着他爸
舅舅好还是爸爸好
弥勒 发表于 2024-7-4 08:17
;**************************20240229年 界点表*****************************************
(defun c:zz ...
谢谢，使用很顺畅
ht1480 发表于 2024-7-4 09:06
点号放在线外对角线上，表格宽度随坐标值的宽度调整
也是非常不错
弥勒 发表于 2024-7-4 08:17
;**************************20240229年 界点表*****************************************
(defun c:zz ...
请问下您，复制代码到lsp文件，然后ap导入插件提示“命令: ; 错误: 输入中的点位置不正确”请教下您是什么原因呀
yanjingcy 发表于 2024-7-17 16:58
请问下您，复制代码到lsp文件，然后ap导入插件提示“命令: ; 错误: 输入中的点位置不正确”请教下您是什 ...
多段线互转 20240701 略调整BY：ZZXXQQ
(DEFUN C:T22 ()
(SETVAR "CMDECHO" 0)
(SETVAR "PLINETYPE" (IF (= (GETVAR "PLINETYPE") 0) 1 0))
(IF (SETQ SS (SSGET '((0 . "*POLYLINE"))))
(PROGN
(SETQ I -1)
(REPEAT (SSLENGTH SS)
(SETQ EN (SSNAME SS (SETQ I (1+ I))))
(COMMAND "EXPLODE" EN)
(COMMAND "PEDIT" "M" "P" "" "Y" "J" 0.5 "")
)
)
)
(SETVAR "CMDECHO" 1)
(PRINC)
)
弥勒 发表于 2024-7-17 17:35
多段线互转 20240701 略调整BY：ZZXXQQ
(DEFUN C:T22 ()
(SETVAR "CMDECHO" 0)
不是这个，是上面那个给多线段节点编号并输出坐标那个代码，20240229 界点表这个代码，会提示“ ; 错误: 输入中的点位置不正确”
yanjingcy 发表于 2024-7-17 17:51
不是这个，是上面那个给多线段节点编号并输出坐标那个代码，20240229 界点表这个代码，会提示“ ; 错误:...
发个你提表格的图看看。
本帖最后由 寒潮大冬瓜 于 2024-12-26 15:28 编辑
DFB二、三维顶点编号→自动字高+自动通过多段线顶点数量确定补齐位数00格式+自动图层名嵌套→波总指导升级版
只要闭着眼睛点击多段线就行了，不用理会参数输入……
(波多菠萝蜜951096036QQ群437857444群主)
(defun WB20240808(SJ12 SS93 / index1 sjg10 sjg18 ss98);自定义函数开始 SS93 SJ12
(setq SJ12(itoa SJ12));编号序号转为字符串
(setq SS98(itoa SS93));顶点个数转为字符串
(setq SJG18(strlen SS98));以整数形式返回一个字符串中字符的个数
(setq SJG10(strlen SJ12));以整数形式返回一个字符串中字符的个数
……
;Yw20240803获取块或直线多段线等图元外围对角坐标及其对角长度
(DEFUN Yw20240803(en / ll strxa strxab strxb strya stryab stryab-min stryb th2 ur)
(vla-getboundingbox (vlax-ename->vla-object en) 'll 'ur)
(setq ll (vlax-safearray->list ll)
……
本帖最后由 jackAqwq 于 2024-8-4 16:02 编辑
缝缝补补，勉强够用
(vl-load-com)
(defun c:ZBB(/ BGZGentss ss1 apt1 apt2 apt3 apt4 BGHG apt1Y apt1X aa i ii pt1 ptdh )
(K:SysVar);修改系统变量
(command "_undo" "be")
;;;程序加载初始化设置
(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)
( gxba BGZG iapt4 0 )
(repeat (length ss)
( setq apt4 (polar apt4 (* pi 1.5) BGHG))
( setq ii(strcat DHQZ (itoa i) ));点号名称
( setq pt1 (car ss1));点号列表
( setq ptdh (polar pt1 (* pi 0.5) (* 1.25 BGZG )));点号位置
( command "text" "MC" ptdh (* 1.0 BGZG )0 ii )
( command ".CIRCLE" pt1 (* 0.12 BGZG) );圈大小
( setq ss1(cdr ss1))
( gxba BGZG iiapt4pt1 )
( setq i (1+ i))
)
(command "_undo" "e")
(K:SysVar);恢复系统变量
(princ)
)
;以下是相应函数
(defun gxba ( 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 K:SysVar ()
(if (not *Old_vars*)
(progn
(setq *New_vars* '((cmdecho 0);取消回显
(OSMode 0);禁用捕捉
(expert 5);禁止提示冲突(默认Yes)
(DimZin 1);不消0
(TextStyle "宋体");设置字体样式
))
(setq *Old_vars* (mapcar'(lambda (a / b)(if (and(setq b (getvar (car a)))(/= b (cadr a)))
(progn
(apply 'setvar a)
(list (car a) b))))
*New_vars*
)
)
(setq *New_vars* nil)
)
(progn
(foreach xx *Old_vars* (if xx (apply 'setvar xx)))
(setq *Old_vars* nil)
)
)
)
;; 创建直线图元
(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)
)
(princ)
jackAqwq 发表于 2024-8-4 16:00
缝缝补补，勉强够用
有重叠线，多余线，文字没居中，其他还不错哈