线段批量转块-平面布置
本帖最后由 ㄘ丶转裑ㄧ灬 于 2025-11-30 14:49 编辑一般用于平面图，把分隔线段替换为制作好的块，块会安装线段角度相应旋转；
用AI写的，两次就正常运行了，还不错；
另外大伙如果对这个功能有更多的想法，可扩展完善后发源码出来。
;;;;;;*****************************************批量布块（遵循线的角度）
(defun c:HT_310 (/ blk blk_data blk_name ss i pline obj pt1 pt2 ang adjusted_ang
insert_point vertex_choice success_count end_param)
(HT_START)
; 选择要插入的块（增加块类型校验）
(setq blk (car (entsel "\n选择要插入的块（竖向块）: ")))
(if (not blk)
(progn (alert "未选择块!") (exit)))
; 验证选中的是块（INSERT类型实体）
(setq blk_data (entget blk))
(if (not (= (cdr (assoc 0 blk_data)) "INSERT"))
(progn (alert "选中的实体不是块，请重新选择！") (exit)))
(setq blk_name (cdr (assoc 2 blk_data)))
; 选择插入点位置
(initget "First Second")
(setq vertex_choice (getkword "\n选择插入点位置 [第一个顶点(F)/第二个顶点(S)] <第一个顶点>: "))
(setq vertex_choice (if vertex_choice vertex_choice "First")) ; 默认第一个顶点
; 选择多段线（支持轻量多段线和二维多段线）
(setq ss (ssget '((0 . "LWPOLYLINE,POLYLINE"))))
(if (not ss)
(progn (alert "未选择多段线!") (exit)))
; 初始化计数器（i=多段线索引，success_count=成功插入次数）
(setq i 0 success_count 0)
; 遍历所有选中的多段线（核心修复：循环逻辑修正）
(repeat (sslength ss)
(setq pline (ssname ss i))
(setq obj (vlax-ename->vla-object pline))
; 检查多段线顶点数（至少2个顶点才计算角度）
(setq end_param (vlax-curve-getEndParam obj))
(if (>= end_param 1) ; param从0开始，>=1表示至少2个顶点
(progn
; 根据用户选择确定插入点和角度参考点
(cond
((= vertex_choice "First")
(setq insert_point (vlax-curve-getStartPoint obj)) ; 插入点：第一个顶点
(setq pt2 (vlax-curve-getPointAtParam obj 1)) ; 参考点：第二个顶点
)
((= vertex_choice "Second")
(setq insert_point (vlax-curve-getPointAtParam obj 1)) ; 插入点：第二个顶点
(setq pt2 (vlax-curve-getStartPoint obj)) ; 参考点：第一个顶点
)
)
; 计算多段线方向角度（弧度），调整为块需要的角度（减90°）
(setq ang (angle insert_point pt2))
(setq adjusted_ang (- ang (/ pi 2)))
(setq adjusted_ang_deg (* adjusted_ang (/ 180 pi))) ; 转为角度（AutoCAD命令要求）
; 插入块（使用实数角度，避免字符串格式问题）
(command "_.INSERT" blk_name insert_point 1 1 adjusted_ang_deg)
(setq success_count (1+ success_count)) ; 成功插入计数+1
)
(progn
; 顶点数不足提示
(princ (strcat "\n多段线" (itoa (1+ i)) "（索引" (itoa i) "）顶点数不足2个，跳过！"))
)
)
(setq i (1+ i)) ; 每次循环仅递增1次（核心修复）
)
; 输出结果提示
(princ (strcat "\n批量插入完成！共处理 " (itoa (sslength ss)) " 条多段线，成功插入 " (itoa success_count) " 个块。"))
(princ "\n提示：若块方向错误，可重新运行并选择「第二个顶点(S)」作为插入点。")
(HT_END)
(princ)
)
;;*************************************************************************************************************************************************
;;;
;;;>>>>>>>>>>>>>>--出错处理_HT-->>>>>>>>>>>>>>>>所用位置：HT_401、402、部分三维改造(因老顾的错误处理对部分用pause的程序不起作用，有的又可以，奇怪)
;;(HT_START)
;;(HT_END)
(defun HT_START ()
(vl-load-com)
(defun error_new (msg)
(if os_old (setvar "osmode" os_old))
(if cmd_old (setvar "cmdecho" cmd_old))
(if DYN1_old (setvar "DYNmode" DYN1_old))
(if DYN2_old (setvar "DYNprompt" DYN2_old))
(if DEL_old (setvar "DELobj" DEL_old))
(if SUB_old (setvar "SUBobjSELECTionmode" SUB_old))
(if CUL_old (setvar "CULlingOBJselection" CUL_old))
(if error_old (setq *error* error_old))
(if (wcmatch (strcase msg t) "*break,*cancel*,*exit*,*取消*")
(redraw)
)
(while (/= 0 (getvar "cmdactive"))(command ""))
(vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
(prompt "*程序错误或用户按ESC取消*")
(princ)
)
(vla-startUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
(setq error_old *error*)
(setq *error* error_new)
(setq os_old (getvar "osmode"))
(setq cmd_old (getvar "cmdecho"))
(setq DYN1_old (getvar "DYNmode"))
(setq DYN2_old (getvar "DYNprompt"))
(setq DEL_old (getvar "DELobj"))
(cond ((>= (atof (getvar "ACADVER")) 18.2 );;判断CAD版本是否大于2012
(setq SUB_old (getvar "SUBobjSELECTionmode"));;过滤选择
(setq CUL_old (getvar "CULlingOBJselection"));;是否可选隐藏对象
)
)
)
(defun HT_END ()
(if os_old (setvar "osmode" os_old))
(if cmd_old (setvar "cmdecho" cmd_old))
(if DYN1_old (setvar "DYNmode" DYN1_old))
(if DYN2_old (setvar "DYNprompt" DYN2_old))
(if DEL_old (setvar "DELobj" DEL_old))
(if SUB_old (setvar "SUBobjSELECTionmode" SUB_old))
(if CUL_old (setvar "CULlingOBJselection" CUL_old))
(if error_old (setq *error* error_old))
(vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
;(vlax-invoke Scriptshell "SendKeys" "+^1") ;启用英文输入法
)
谢谢分享
页:
[1]