线段批量转块-平面布置

ㄘ丶转裑ㄧ灬

一般用于平面图，把分隔线段替换为制作好的块，块会安装线段角度相应旋转；
用AI写的，两次就正常运行了，还不错；
另外大伙如果对这个功能有更多的想法，可扩展完善后发源码出来。

1. ;;;;;;*****************************************批量布块（遵循线的角度）
   
2. 
   
3. (defun c:HT_310 (/ blk blk_data blk_name ss i pline obj pt1 pt2 ang adjusted_ang
   
4.                     insert_point vertex_choice success_count end_param)
   
5.   (HT_START)
   
6.   
   
7.   ; 选择要插入的块（增加块类型校验）
   
8.   (setq blk (car (entsel "\n选择要插入的块（竖向块）: ")))
   
9.   (if (not blk)
   
10.     (progn (alert "未选择块!") (exit)))
    
11.   
    
12.   ; 验证选中的是块（INSERT类型实体）
    
13.   (setq blk_data (entget blk))
    
14.   (if (not (= (cdr (assoc 0 blk_data)) "INSERT"))
    
15.     (progn (alert "选中的实体不是块，请重新选择！") (exit)))
    
16.   (setq blk_name (cdr (assoc 2 blk_data)))
    
17.   
    
18.   ; 选择插入点位置
    
19.   (initget "First Second")
    
20.   (setq vertex_choice (getkword "\n选择插入点位置 [第一个顶点(F)/第二个顶点(S)] <第一个顶点>: "))
    
21.   (setq vertex_choice (if vertex_choice vertex_choice "First")) ; 默认第一个顶点
    
22.   
    
23.   ; 选择多段线（支持轻量多段线和二维多段线）
    
24.   (setq ss (ssget '((0 . "LWPOLYLINE,POLYLINE"))))
    
25.   (if (not ss)
    
26.     (progn (alert "未选择多段线!") (exit)))
    
27.   
    
28.   ; 初始化计数器（i=多段线索引，success_count=成功插入次数）
    
29.   (setq i 0 success_count 0)
    
30.   
    
31.   ; 遍历所有选中的多段线（核心修复：循环逻辑修正）
    
32.   (repeat (sslength ss)
    
33.     (setq pline (ssname ss i))
    
34.     (setq obj (vlax-ename->vla-object pline))
    
35.    
    
36.     ; 检查多段线顶点数（至少2个顶点才计算角度）
    
37.     (setq end_param (vlax-curve-getEndParam obj))
    
38.     (if (>= end_param 1) ; param从0开始，>=1表示至少2个顶点
    
39.       (progn
    
40.         ; 根据用户选择确定插入点和角度参考点
    
41.         (cond
    
42.           ((= vertex_choice "First")
    
43.             (setq insert_point (vlax-curve-getStartPoint obj)) ; 插入点：第一个顶点
    
44.             (setq pt2 (vlax-curve-getPointAtParam obj 1))      ; 参考点：第二个顶点
    
45.           )
    
46.           ((= vertex_choice "Second")
    
47.             (setq insert_point (vlax-curve-getPointAtParam obj 1)) ; 插入点：第二个顶点
    
48.             (setq pt2 (vlax-curve-getStartPoint obj))             ; 参考点：第一个顶点
    
49.           )
    
50.         )
    
51.         
    
52.         ; 计算多段线方向角度（弧度），调整为块需要的角度（减90°）
    
53.         (setq ang (angle insert_point pt2))
    
54.         (setq adjusted_ang (- ang (/ pi 2)))
    
55.         (setq adjusted_ang_deg (* adjusted_ang (/ 180 pi))) ; 转为角度（AutoCAD命令要求）
    
56.         
    
57.         ; 插入块（使用实数角度，避免字符串格式问题）
    
58.         (command "_.INSERT" blk_name insert_point 1 1 adjusted_ang_deg)
    
59.         
    
60.         (setq success_count (1+ success_count)) ; 成功插入计数+1
    
61.       )
    
62.       (progn
    
63.         ; 顶点数不足提示
    
64.         (princ (strcat "\n多段线" (itoa (1+ i)) "（索引" (itoa i) "）顶点数不足2个，跳过！"))
    
65.       )
    
66.     )
    
67.    
    
68.     (setq i (1+ i)) ; 每次循环仅递增1次（核心修复）
    
69.   )
    
70.   
    
71.   ; 输出结果提示
    
72.   (princ (strcat "\n批量插入完成！共处理 " (itoa (sslength ss)) " 条多段线，成功插入 " (itoa success_count) " 个块。"))
    
73.   (princ "\n提示：若块方向错误，可重新运行并选择「第二个顶点(S)」作为插入点。")
    
74.   (HT_END)
    
75.   (princ)
    
76. )

;;;;;;*****************************************批量布块（遵循线的角度）<br /> <br /> (defun c:HT_310 (/ blk blk_data blk_name ss i pline obj pt1 pt2 ang adjusted_ang <br />                     insert_point vertex_choice success_count end_param)<br />   (HT_START)<br />   <br />   ; 选择要插入的块（增加块类型校验）<br />   (setq blk (car (entsel "\n选择要插入的块（竖向块）: ")))<br />   (if (not blk)<br />     (progn (alert "未选择块!") (exit)))<br />   <br />   ; 验证选中的是块（INSERT类型实体）<br />   (setq blk_data (entget blk))<br />   (if (not (= (cdr (assoc 0 blk_data)) "INSERT"))<br />     (progn (alert "选中的实体不是块，请重新选择！") (exit)))<br />   (setq blk_name (cdr (assoc 2 blk_data)))<br />   <br />   ; 选择插入点位置<br />   (initget "First Second")<br />   (setq vertex_choice (getkword "\n选择插入点位置 [第一个顶点(F)/第二个顶点(S)] <第一个顶点>: "))<br />   (setq vertex_choice (if vertex_choice vertex_choice "First")) ; 默认第一个顶点<br />   <br />   ; 选择多段线（支持轻量多段线和二维多段线）<br />   (setq ss (ssget '((0 . "LWPOLYLINE,POLYLINE"))))<br />   (if (not ss)<br />     (progn (alert "未选择多段线!") (exit)))<br />   <br />   ; 初始化计数器（i=多段线索引，success_count=成功插入次数）<br />   (setq i 0 success_count 0)<br />   <br />   ; 遍历所有选中的多段线（核心修复：循环逻辑修正）<br />   (repeat (sslength ss)<br />     (setq pline (ssname ss i))<br />     (setq obj (vlax-ename->vla-object pline))<br />     <br />     ; 检查多段线顶点数（至少2个顶点才计算角度）<br />     (setq end_param (vlax-curve-getEndParam obj))<br />     (if (>= end_param 1) ; param从0开始，>=1表示至少2个顶点<br />       (progn<br />         ; 根据用户选择确定插入点和角度参考点<br />         (cond<br />           ((= vertex_choice "First")<br />             (setq insert_point (vlax-curve-getStartPoint obj)) ; 插入点：第一个顶点<br />             (setq pt2 (vlax-curve-getPointAtParam obj 1))      ; 参考点：第二个顶点<br />           )<br />           ((= vertex_choice "Second")<br />             (setq insert_point (vlax-curve-getPointAtParam obj 1)) ; 插入点：第二个顶点<br />             (setq pt2 (vlax-curve-getStartPoint obj))             ; 参考点：第一个顶点<br />           )<br />         )<br />         <br />         ; 计算多段线方向角度（弧度），调整为块需要的角度（减90°）<br />         (setq ang (angle insert_point pt2))<br />         (setq adjusted_ang (- ang (/ pi 2)))<br />         (setq adjusted_ang_deg (* adjusted_ang (/ 180 pi))) ; 转为角度（<a href="http://bbs.mjtd.com/forum-41-1.html" target="_blank" class="relatedlink">AutoCAD</a>命令要求）<br />         <br />         ; 插入块（使用实数角度，避免字符串格式问题）<br />         (command "_.INSERT" blk_name insert_point 1 1 adjusted_ang_deg)<br />         <br />         (setq success_count (1+ success_count)) ; 成功插入计数+1<br />       )<br />       (progn<br />         ; 顶点数不足提示<br />         (princ (strcat "\n多段线" (itoa (1+ i)) "（索引" (itoa i) "）顶点数不足2个，跳过！"))<br />       )<br />     )<br />     <br />     (setq i (1+ i)) ; 每次循环仅递增1次（核心修复）<br />   )<br />   <br />   ; 输出结果提示<br />   (princ (strcat "\n批量插入完成！共处理 " (itoa (sslength ss)) " 条多段线，成功插入 " (itoa success_count) " 个块。"))<br />   (princ "\n提示：若块方向错误，可重新运行并选择「第二个顶点(S)」作为插入点。")<br />   (HT_END)<br />   (princ)<br /> )

1. ;;*************************************************************************************************************************************************
   
2. ;;;
   
3. ;;;>>>>>>>>>>>>>>--出错处理_HT-->>>>>>>>>>>>>>>>所用位置：HT_401、402、部分三维改造(因老顾的错误处理对部分用pause的程序不起作用，有的又可以，奇怪)
   
4. ;;(HT_START)
   
5. ;;(HT_END)
   
6. 
   
7. (defun HT_START ()
   
8.   (vl-load-com)
   
9.     (defun error_new (msg)
   
10.       (if os_old (setvar "osmode" os_old))
    
11.       (if cmd_old (setvar "cmdecho" cmd_old))
    
12.       (if DYN1_old (setvar "DYNmode" DYN1_old))
    
13.       (if DYN2_old (setvar "DYNprompt" DYN2_old))
    
14.       (if DEL_old (setvar "DELobj" DEL_old))
    
15.       (if SUB_old (setvar "SUBobjSELECTionmode" SUB_old))
    
16.       (if CUL_old (setvar "CULlingOBJselection" CUL_old))
    
17.       (if error_old (setq *error* error_old))      
    
18.       (if (wcmatch (strcase msg t) "*break,*cancel*,*exit*,*取消*")
    
19.         (redraw)
    
20.       )
    
21.       (while (/= 0 (getvar "cmdactive"))(command ""))
    
22.       (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
    
23.       (prompt "*程序错误或用户按ESC取消*")
    
24.       (princ)
    
25.     )
    
26.   (vla-startUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
    
27.   (setq error_old *error*)   
    
28.   (setq *error* error_new)
    
29.   (setq os_old (getvar "osmode"))
    
30.   (setq cmd_old (getvar "cmdecho"))
    
31.   (setq DYN1_old (getvar "DYNmode"))
    
32.   (setq DYN2_old (getvar "DYNprompt"))
    
33.   (setq DEL_old (getvar "DELobj"))
    
34.   (cond ((>= (atof (getvar "ACADVER")) 18.2 );;判断CAD版本是否大于2012
    
35.       (setq SUB_old (getvar "SUBobjSELECTionmode"));;过滤选择
    
36.       (setq CUL_old (getvar "CULlingOBJselection"));;是否可选隐藏对象
    
37.       )
    
38.   )
    
39. )
    
40. 
    
41. (defun HT_END ()
    
42.   (if os_old (setvar "osmode" os_old))
    
43.   (if cmd_old (setvar "cmdecho" cmd_old))
    
44.   (if DYN1_old (setvar "DYNmode" DYN1_old))
    
45.   (if DYN2_old (setvar "DYNprompt" DYN2_old))
    
46.   (if DEL_old (setvar "DELobj" DEL_old))
    
47.   (if SUB_old (setvar "SUBobjSELECTionmode" SUB_old))
    
48.   (if CUL_old (setvar "CULlingOBJselection" CUL_old))
    
49.   (if error_old (setq *error* error_old))
    
50.   (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
    
51.   ;(vlax-invoke Scriptshell "SendKeys" "+^1") ;启用英文输入法
    
52. )
    

;;************************************************************************************************************************************************* <br /> ;;;<br /> ;;;>>>>>>>>>>>>>>--出错处理_HT-->>>>>>>>>>>>>>>>所用位置：HT_401、402、部分三维改造(因老顾的错误处理对部分用pause的程序不起作用，有的又可以，奇怪)<br /> ;;(HT_START)<br /> ;;(HT_END)<br /> <br /> (defun HT_START ()<br />   (vl-load-com)<br />     (defun error_new (msg)<br />       (if os_old (setvar "osmode" os_old))<br />       (if cmd_old (setvar "cmdecho" cmd_old))<br />       (if DYN1_old (setvar "DYNmode" DYN1_old))<br />       (if DYN2_old (setvar "DYNprompt" DYN2_old))<br />       (if DEL_old (setvar "DELobj" DEL_old))<br />       (if SUB_old (setvar "SUBobjSELECTionmode" SUB_old))<br />       (if CUL_old (setvar "CULlingOBJselection" CUL_old))<br />       (if error_old (setq *error* error_old))      <br />       (if (wcmatch (strcase msg t) "*break,*cancel*,*exit*,*取消*")<br />         (redraw)<br />       )<br />       (while (/= 0 (getvar "cmdactive"))(command ""))<br />       (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))<br />       (prompt "*程序错误或用户按ESC取消*")<br />       (princ)<br />     )<br />   (vla-startUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))<br />   (setq error_old *error*)   <br />   (setq *error* error_new)<br />   (setq os_old (getvar "osmode"))<br />   (setq cmd_old (getvar "cmdecho"))<br />   (setq DYN1_old (getvar "DYNmode"))<br />   (setq DYN2_old (getvar "DYNprompt"))<br />   (setq DEL_old (getvar "DELobj"))<br />   (cond ((>= (atof (getvar "ACADVER")) 18.2 );;判断CAD版本是否大于2012<br />       (setq SUB_old (getvar "SUBobjSELECTionmode"));;过滤选择<br />       (setq CUL_old (getvar "CULlingOBJselection"));;是否可选隐藏对象<br />       )<br />   )<br /> )<br /> <br /> (defun HT_END ()<br />   (if os_old (setvar "osmode" os_old))<br />   (if cmd_old (setvar "cmdecho" cmd_old))<br />   (if DYN1_old (setvar "DYNmode" DYN1_old))<br />   (if DYN2_old (setvar "DYNprompt" DYN2_old))<br />   (if DEL_old (setvar "DELobj" DEL_old))<br />   (if SUB_old (setvar "SUBobjSELECTionmode" SUB_old))<br />   (if CUL_old (setvar "CULlingOBJselection" CUL_old))<br />   (if error_old (setq *error* error_old))<br />   (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))<br />   ;(vlax-invoke Scriptshell "SendKeys" "+^1") ;启用英文输入法<br /> )<br />

lxl217114

谢谢分享