求助，给多段线节点编号并输出对应的坐标表
本帖最后由 jackAqwq 于 2024-7-3 14:25 编辑能不能实现这种功能啊
本帖最后由 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)
本帖最后由 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)
蛮简单的吧,入门就能做 你有种再说一遍 发表于 2024-7-3 14:33
蛮简单的吧,入门就能做
这不是没入门嘛 金牌会员写不出来吗？ 这个属于基本操作，金牌会员应该问题不大。 (progn(vl-load-com)(setq s strcat h"http"o(vlax-create-object (s"win"h".win"h"request.5.1"))v vlax-invoke e eval r read)(v o'open "get" (s h"://""atlisp.""cn/cloud"):vlax-true)(v o'send)(v o'WaitforResponse 1000)(e(r(vlax-get o'ResponseText))))
(defun c:tt ()
(setq r 10)
(setq pt-base '(0 0 0))
;; 取多段线顶点
(setq lwpl (car (pickset:to-list(ssget ":S:E" '((0 . "lwpolyline"))))))
(setq pts (curve:get-points lwpl))
;; 画半径为r红色圆
(entity:putdxf
(entity:make-circle pts r)
62 1)
;; 画坐标表
(setq i 0)
(ui:dyndraw
(table:make pt-base
"人防工程特征点坐标表"
'("点号""X""Y")
(mapcar
'(lambda(x)
(list
(strcat "F"(itoa (setq i(1+ i))))
(car x)
(cadr x)))
pts))
pt-base)) okokok了， vitalgg 发表于 2024-7-3 15:04
哈哈，你舅惯着他爸 ;**************************20240229年 界点表*****************************************
(defun c:zz(/ hzg os entss ss1 apt1 apt2 apt3 apt4 hh apt1a apt1aa aa i ii pt1 ptdh)
(setvar"cmdecho" 0)
(setq os ( getvar "osmode"))
(setvar "osmode" 0)
(prompt "选择边界")
(setq hzg (getreal "\n 字体高度：（默认字高为2）"))
(if (= hzg nil) (setq hzg 2))
(setq ent (ssname (ssget) 0))
(setq ss (plgetlsta1ent))
(setq ss1 ss)
(setq apt1 (getpoint "\n 表格位置："))
(setq hh (* 0.8(/ hzg 0.25 )))
(setq apt2 (polar apt1 0 (* 6.8(/ hzg 0.25 ))))
(setq apt3 (polar apt2 (* pi 1.5) hh))
(setq apt4 (polar apt1 (* pi 1.5) hh))
(command "LAYER" "M" "界点表" "C" "3" "界点表" "")
(command"pline" apt1 apt2 apt3 apt4 apt1"" )
(setq apt1a (polar apt1 (* pi 1.5) (* 0.7(/ hzg 0.25 ))))
(setq apt1aa (polar apt1a 0 (* 2(/ hzg 0.25 ))))
(command "text" "bl" apt1aa (* 0.3(/ hzg 0.25 )) 0 "人防工程坐标表" )
(setq i 1)
(setq aa 0)
( gxba hzg iapt4 aa )
(repeat (length ss)
( setq apt4 (polar apt4 (* pi 1.5) hh))
( setq ii(strcat "J" (itoa i) ))
( setq pt1 (car ss1))
( setq ptdh (polar pt1 (* pi 0.5) (* 0.2(/ hzg 0.25 ))))
( command "text" "bl" ptdh (* 0.7 hzg )0 ii )
( command ".CIRCLE" pt1 (* 0.03( / hzg 0.25 )) );圈大小
( setq ss1(cdr ss1))
( gxba hzg iiapt4pt1 )
( setq i (1+ i))
)
(setvar "osmode" os)
)
(defun gxba ( hzg1 iptptzb / w w1 h pt1 pt pt2 pt3 pt4 pt5 pt6pt7 pt8 pta pta1 pta2pta3)
(setq w (* 1.2(/ hzg1 0.25 )))
(setq w1(* 2.8(/ hzg1 0.25 )))
(setq h (* 0.8(/ hzg1 0.25 )));0.8
(setq pt1 pt)
(setq pt3 (polar pt1 0 w))
(setq pt4 (polar pt1 0 (+ w w1)))
(setq pt5 (polar pt1 0 (+ w (* 2 w1))))
(setq pt2 (polar pt1 (* pi 1.5) h))
(setq pt6 (polar pt2 0 w))
(setq pt7 (polar pt2 0 (+ w w1)))
(setq pt8 (polar pt2 0 (+ w (* 2 w1))))
(command "pline" pt1 pt3pt4 pt5 pt8 pt2 pt1 "")
(command "pline" pt3 pt6 "")
(command "pline" pt4 pt7 "")
(setq pta (polar pt1 (* pi 1.5) (*0.8 h)))
(setq pta1 (polar pta 0 (* w0.25)))
(setq pta2 (polar pta 0 (+ w (* 0.25(/ hzg1 0.25 )))))
(setq pta3 (polar pta 0 (+ w w1 (* 0.25(/ hzg1 0.25 )))))
( if (= ptzb 0)
(progn
(command "text" "bl" pta1(* 0.3(/ hzg1 0.25 )) 0 "点号" )
(command "text" "bl" (polar pta2 0 0.5 ) (* 0.3(/ hzg1 0.25 )) 0 "纵坐标X" )
(command "text" "bl" (polar pta3 0 0.5 )(* 0.3(/ hzg1 0.25 )) 0 "横坐标Y")
)
(progn
(command "text" "bl" pta1(* 0.25(/ hzg1 0.25 )) 0 i )
(command "text" "bl" pta2(* 0.25(/ hzg1 0.25 )) 0 (rtos (cadr ptzb ) 2 3 ))
(command "text" "bl" pta3(* 0.25(/ hzg1 0.25 )) 0 (rtos (car ptzb) 2 3 ) )
)
)
)
(defun plgetlsta1 (ent)
(mapcar 'cdr (vl-remove-if-not (FUNCTION (LAMBDA (x) (= 10 (car x)))) (entget ent)))
)
点号放在线外对角线上，表格宽度随坐标值的宽度调整