求助，给多段线节点编号并输出对应的坐标表

664571221 · 发表于 2024-7-4 09:19:41

橡皮发表于 2024-7-3 15:54
哈哈，你舅惯着他爸

舅舅好还是爸爸好

jackAqwq · 发表于 2024-7-6 13:50:20

弥勒发表于 2024-7-4 08:17
;**************************20240229年界点表*****************************************

(defun c:zz ...

谢谢，使用很顺畅

jackAqwq · 发表于 2024-7-6 13:51:43

ht1480 发表于 2024-7-4 09:06
点号放在线外对角线上，表格宽度随坐标值的宽度调整

也是非常不错

yanjingcy · 发表于 2024-7-17 16:58:06

弥勒发表于 2024-7-4 08:17
;**************************20240229年界点表*****************************************

(defun c:zz ...

请问下您，复制代码到lsp文件，然后ap导入插件提示“命令: ; 错误: 输入中的点位置不正确”请教下您是什么原因呀

弥勒 · 发表于 2024-7-17 17:35:23

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)
)

yanjingcy · 发表于 2024-7-17 17:51:35

弥勒发表于 2024-7-17 17:35
多段线互转 20240701 略调整BY：ZZXXQQ
(DEFUN C:T22 ()
(SETVAR "CMDECHO" 0)

不是这个，是上面那个给多线段节点编号并输出坐标那个代码，20240229 界点表这个代码，会提示“ ; 错误: 输入中的点位置不正确”

弥勒 · 发表于 2024-7-18 09:40:59

yanjingcy 发表于 2024-7-17 17:51
不是这个，是上面那个给多线段节点编号并输出坐标那个代码，20240229 界点表这个代码，会提示“ ; 错误: ...

发个你提表格的图看看。

寒潮大冬瓜 · 发表于 2024-8-3 23:59:35

本帖最后由寒潮大冬瓜于 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:00:13

本帖最后由 jackAqwq 于 2024-8-4 16:02 编辑

缝缝补补，勉强够用

(vl-load-com)
(defun c:ZBB(/ BGZG ent ss 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 (plgetlsta1 ent))
(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 i apt4 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 ii apt4 pt1 )
( setq i (1+ i))
)
(command "_undo" "e")
(K:SysVar);恢复系统变量
(princ)
)
;以下是相应函数
(defun gxba ( BGZG i pt ptzb / w h pta pta1 pta2 pta3)
(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)

(vl-load-com) 
(defun c:ZBB(/ BGZG  ent  ss 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 (plgetlsta1  ent)) 
  (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 i  apt4   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 ii  apt4  pt1 ) 
    ( setq i (1+ i)) 
  ) 
  (command "_undo" "e") 
  (K:SysVar);恢复系统变量 
  (princ) 
) 
;以下是相应函数 
(defun gxba ( BGZG i  pt  ptzb / w h  pta pta1 pta2  pta3) 
  (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)

muai2010 · 发表于 2024-8-4 23:49:53

jackAqwq 发表于 2024-8-4 16:00
缝缝补补，勉强够用

有重叠线，多余线，文字没居中，其他还不错哈

账号		自动登录	找回密码
密码			注册

求助，给多段线节点编号并输出对应的坐标表

本帖子中包含更多资源