没钱发几个小插件赚点明经币

scnc001

看是什么内容也要开盲盒？

白山茶

有人开了盲盒说下是啥功能的插件吗

BUBUBA918

yy6831817 发表于 2025-8-30 15:50
;; ===============================================================
;;  功能：批量选中填充图案面积值 ...

选择对象:
; 错误: 参数类型错误: VLA-OBJECT nil

无法运行

yy6831817

BUBUBA918 发表于 2025-9-1 14:32
选择对象:
; 错误: 参数类型错误: VLA-OBJECT nil

命令: ZZ提取填充面积
请选择要计算面积的填充图案:
选择对象: 找到 1 个
选择对象: 找到 1 个，总计 2 个
选择对象: 找到 1 个，总计 3 个
选择对象:
已写入 Excel: 0.102+0.344+0.236 我这边正常

yy6831817

;; ===============================================================
;;  功能：设置标注比例
;;  命令：ZZ设置标注比例
;;  格式：修改当前标注样式中的主单位测量单位比例因子(E)值先设为1【过程中断后返回1】
;; ===============================================================
(defun c:ZZ设置标注比例 (/ pt1 pt2 dist user-val scale-factor old-dimlfac old-osmode)
  ; 保存当前系统变量设置
  (setq old-dimlfac (getvar "dimlfac"))
  (setq old-osmode (getvar "osmode")) ; 保存当前对象捕捉设置
  (setvar "cmdecho" 0)
  
  ; 先将标注比例因子重置为1
  (setvar "dimlfac" 1.0)
  
  ; 获取第一点
  (if (setq pt1 (getpoint "\n请指定第一点: "))
    (progn
      ; 获取第二点
      (if (setq pt2 (getpoint pt1 "\n请指定第二点: "))
        (progn
          ; 计算两点之间的距离（实际测量值）
          (setq dist (distance pt1 pt2))
         
          ; 创建线性标注
          (command "_.dimlinear" pt1 pt2 "" "")
         
          ; 提示用户输入实际尺寸，并显示当前测量值
          (setq user-val (getreal
                          (strcat "\n请输入两点之间的实际尺寸[当前测量值为："
                                  (rtos dist 2 2) "]: ")))
         
          ; 检查用户输入是否有效
          (if (and user-val (> user-val 0) (/= dist 0))
            (progn
              ; 计算比例因子：输入值/实际测量值
              (setq scale-factor (/ user-val dist))
              
              ; 设置新的比例因子
              (setvar "dimlfac" scale-factor)
              
              ; 显示操作结果
              (princ (strcat "\n标注比例因子已更新为: " (rtos scale-factor 2 6)))
            )
            (progn
              (setvar "dimlfac" old-dimlfac) ; 恢复原始值
              (princ "\n输入无效或距离为零，请输入一个正数。")
            )
          )
        )
        (princ "\n未指定第二点，命令取消。")
      )
    )
    (princ "\n未指定第一点，命令取消。")
  )
  
  ; 恢复系统变量设置（使用保存的原始值）
  (setvar "cmdecho" 1)
  (setvar "osmode" old-osmode) ; 恢复用户原始的对象捕捉设置
  (princ)
)

yy6831817

;; ===============================================================
;;  功能：文字左、右、中心位对齐，调整行距，调整字高
;;  命令：ZZ文字对齐
;;  格式：按CAD视觉上下顺序排列 ，单行多行字均可
;; ===============================================================
(defun c:ZZ文字对齐()
  (setvar "cmdecho" 0)
  (setq txt (ssget '((0 . "TEXT,MTEXT"))))
  
  ;; 检查选择
  (if (not txt)
    (progn
      (princ "\n未选择任何文本对象！")
      (setvar "cmdecho" 1)
      (return)
    )
  )
  (setq totalNum (sslength txt))
  
  ;; 仅选择了1个文本时，直接进入调整字高功能
  (if (= totalNum 1)
    (progn
      (princ "\n仅选择了1个文本，将直接调整其高度！")
      (setq opType 5)  ; 强制设置为调整文字高度模式
    )
    (progn
      ;; 多个文本时正常选择操作类型
      (setq opType (getint "\n请选择操作 [1=左对齐/2=中间对齐/3=右对齐/4=仅调整行距/5=调整文字高] <1>: "))
      (if (not opType) (setq opType 1))
      (if (not (member opType '(1 2 3 4 5)))
        (progn (princ "\n无效选择，默认左对齐") (setq opType 1))
      )
    )
  )

  ;; 收集所有文本信息并计算视觉顶部位置（用于排序）
  (setq textData '())
  (setq i 0)
  (while (< i totalNum)
    (setq ent (ssname txt i))
    (setq entList (entget ent))
    (setq entType (cdr (assoc '0 entList)))
    (setq entY (cadr (cdr (assoc '10 entList)))) ; Y坐标
    (setq entHeight (cdr (assoc '40 entList)))   ; 文字高度
   
    ;; 计算视觉顶部位置（用于排序的关键值）
    (if (= entType "TEXT")
      ;; 单行文字的视觉顶部 = Y坐标（基线） + 高度
      (setq visualTop (+ entY entHeight))
      ;; 多行文字的视觉顶部 = Y坐标（本身就是顶部）
      (setq visualTop entY)
    )
   
    ;; 保存数据：视觉顶部、实体、类型、高度、原始索引
    (setq textData (append textData (list (list visualTop ent entType entHeight i))))
    (setq i (1+ i))
  )

  ;; 按视觉顶部位置排序（从上到下）
  (setq sortedData (vl-sort textData '(lambda (a b) (> (car a) (car b)))))

  ;; 调整文字高度
  (if (= opType 5)
    (progn
      (setq firstEnt (cadr (car sortedData))) ; 最上方文字
      (setq firstH (cadddr (car sortedData)))
      (setq newH (getreal (strcat "\n输入新文字高度 <" (rtos firstH) ">: ")))
      
      (if (and newH (> newH 0))
        (progn
          (foreach item sortedData
            (setq ent (cadr item))
            (setq entList (entget ent))
            (entmod (subst (cons '40 newH) (assoc '40 entList) entList))
          )
          (princ (strcat "\n所有文字高度已调整为: " (rtos newH)))
        )
        (princ "\n无效高度，不调整")
      )
      (setvar "cmdecho" 1)
      (princ "\n操作完成")
      (return)
    )
  )

  ;; 水平对齐
  (if (/= opType 4)
    (progn
      (cond
        ((= opType 1) (setq pt (getpoint "\n拾取左对齐定位点:")) (setq hCode 0))
        ((= opType 2) (setq pt (getpoint "\n拾取中间对齐定位点:")) (setq hCode 1))
        ((= opType 3) (setq pt (getpoint "\n拾取右对齐定位点:")) (setq hCode 2))
      )
      (setq targetX (car pt))

      (foreach item sortedData
        (setq ent (cadr item))
        (setq entType (caddr item))
        (setq entList (entget ent))
        (setq old10 (assoc '10 entList))
        (setq oldY (cadr (cdr old10)))
        (setq oldZ (caddr (cdr old10)))
        
        ;; 设置水平对齐
        (if (assoc '72 entList)
          (entmod (subst (cons '72 hCode) (assoc '72 entList) entList))
          (entmod (append entList (list (cons '72 hCode))))
        )
        
        ;; 修改X坐标（保持Y不变）
        (entmod (subst (cons '10 (list targetX oldY oldZ)) old10 (entget ent)))
      )
    )
  )

  ;; 行距调整（按视觉顺序排列）
  (setq spacing (getreal "\n输入行距（直接回车不调整）: "))
  (if (and spacing (> spacing 0))
    (progn
      (command "undo" "begin")

      ;; 获取最上方文字作为基准
      (setq baseItem (car sortedData))
      (setq baseEnt (cadr baseItem))
      (setq baseType (caddr baseItem))
      (setq baseHeight (cadddr baseItem))
      (setq baseEntList (entget baseEnt))
      (setq base10 (assoc '10 baseEntList))
      (setq baseX (cadr base10))
      (setq baseZ (caddr base10))
      
      ;; 计算基准行的视觉顶部
      (setq currentVisualTop (car baseItem))

      ;; 按视觉顺序（从上到下）调整后续行
      (setq i 1)
      (while (< i totalNum)
        (setq currItem (nth i sortedData))
        (setq currEnt (cadr currItem))
        (setq currType (caddr currItem))
        (setq currHeight (cadddr currItem))
        (setq currEntList (entget currEnt))
        (setq curr10 (assoc '10 currEntList))
        (setq currX (cadr curr10))
        (setq currZ (caddr curr10))

        ;; 计算当前行的视觉顶部（基于上一行）
        (setq currVisualTop (- currentVisualTop spacing))

        ;; 根据类型计算实际Y坐标
        (if (= currType "TEXT")
          ;; 单行文字：Y = 视觉顶部 - 高度（基线位置）
          (setq newY (- currVisualTop currHeight))
          ;; 多行文字：Y = 视觉顶部（顶部位置）
          (setq newY currVisualTop)
        )

        ;; 更新当前行位置
        (entmod (subst (cons '10 (list currX newY currZ)) curr10 currEntList))

        ;; 更新当前视觉顶部为下一行的基准
        (setq currentVisualTop currVisualTop)
        (setq i (1+ i))
      )

      (command "undo" "end")
      (princ (strcat "\n行距调整完成！行距: " (rtos spacing)))
    )
  )

  (setvar "cmdecho" 1)
  (princ "\n操作完成")
  (princ)
)

yy6831817

;; ===============================================================
;;  功能：引出点坐标（XY可互换）
;;  命令：ZZ坐标标注
;;  格式：
;; ===============================================================
(defun c:ZZ坐标标注 (/ *ZXC-TEXTHIGH* *ZXC-SWAPXY* LC:TEXTLENGTH TEXTSTYLE-BAK TEXTSIZE-BAK TEXTHIGH XSWS PT1 PT1_WCS PT2 STRLST TEXTLENGTH PT3 LST swapChoice gr)
    (vl-load-com)
   
    ;; 定义全局变量保存文字高度和坐标互换设置
    (if (not *ZXC-TEXTHIGH*)
        (setq *ZXC-TEXTHIGH* 30)
    )
    (if (not *ZXC-SWAPXY*)
        (setq *ZXC-SWAPXY* 2)  ; 1=不互换，2=互换
    )
   
    ;; 让用户选择是否互换坐标
    (setq swapChoice (getint (strcat "\n坐标(xy)是否互换 (1=否 2=是[建筑坐标])<" (itoa *ZXC-SWAPXY*) ">: ")))
    (if (and swapChoice (or (= swapChoice 1) (= swapChoice 2)))
        (setq *ZXC-SWAPXY* swapChoice)
    )
   
    (defun LC:TextLength (String / Tbox)
        (setq Tbox (textbox (list (cons 1 String))))
        (distance (car Tbox) (cadr Tbox))
    )
   
    (setq TEXTSTYLE-bak (getvar "TEXTSTYLE"))
    (setvar "TEXTSTYLE" "Standard")
    (setq textsize-bak (getvar "TEXTSIZE"))
   
    ;; 使用上一次的高度作为默认值
    (setq texthigh (getreal (strcat "\n请输入文字高度<" (rtos *ZXC-TEXTHIGH*) ">: ")))
    (if (null texthigh)
        (setq texthigh *ZXC-TEXTHIGH*)
        (setq *ZXC-TEXTHIGH* texthigh)
    )
    (setvar "TEXTSIZE" texthigh)
   
    ; 取消小数位数输入，直接设置为3
    (setq xsws 3)
   
    (defun DrawTempObjects (pt1 pt2 / strlst textlength pt3 text1-pos text2-pos)
        ;; 根据全局变量决定是否互换X和Y值
        (if (= *ZXC-SWAPXY* 2)
            (setq strlst (mapcar 'strcat '("X=" "Y=")
                                 (mapcar '(lambda (x) (rtos x 2 xsws)) (list (cadr pt1) (car pt1))))) ; 互换位置
            (setq strlst (mapcar 'strcat '("X=" "Y=")
                                 (mapcar '(lambda (x) (rtos x 2 xsws)) (list (car pt1) (cadr pt1))))) ; 正常位置
        )
        
        (setq textlength (apply 'MAX (mapcar '(lambda (x) (LC:TextLength x)) strlst)))
        (setq pt3 (if (> (car pt2) (car pt1))
                      (polar pt2 0 (+ textlength 1))
                      (polar pt2 pi (+ textlength 1))
                  ))
        
        ;; 绘制临时引线 - 从实际选择点(pt1)引出，不转换为WCS坐标
        (grdraw pt1 pt2 3 1)  ; 从选择点到中间点
        (grdraw pt2 pt3 3 1)   ; 从中间点到文字位置
        
        ;; 计算文字位置
        (setq text1-pos (polar (polar (if (>= (car pt2) (car pt1)) pt2 pt3) 0 0.5) (* 0.5 pi) (* texthigh 0.2)))
        (setq text2-pos (polar (polar (if (>= (car pt2) (car pt1)) pt2 pt3) 0 0.5) (* 1.5 pi) (+ (* texthigh 0.2) texthigh)))
        
        ;; 绘制临时文字
        (DrawTextSimulation text1-pos (car strlst) texthigh)
        (DrawTextSimulation text2-pos (cadr strlst) texthigh)
    )
   
    (defun DrawTextSimulation (pt text height / bbox width)
        ;; 简单模拟文字显示
        (setq bbox (textbox (list (cons 1 text) (cons 40 height))))
        (setq width (distance (car bbox) (cadr bbox)))
        
        ;; 绘制文字边框以模拟文字 - 不转换为WCS坐标
        (grdraw (list (- (car pt) 0.5) (- (cadr pt) 0.5))
                (list (+ (car pt) width 0.5) (- (cadr pt) 0.5)) 7 1)
        (grdraw (list (+ (car pt) width 0.5) (- (cadr pt) 0.5))
                (list (+ (car pt) width 0.5) (+ (cadr pt) height 0.5)) 7 1)
        (grdraw (list (+ (car pt) width 0.5) (+ (cadr pt) height 0.5))
                (list (- (car pt) 0.5) (+ (cadr pt) height 0.5)) 7 1)
        (grdraw (list (- (car pt) 0.5) (+ (cadr pt) height 0.5))
                (list (- (car pt) 0.5) (- (cadr pt) 0.5)) 7 1)
    )
   
    ;; 取消"指定注记点"提示，直接获取点
    (while (setq pt1 (getpoint "\n选择注记点或按ESC退出: "))
        ;; 保存WCS坐标用于实体创建（仅实体创建时使用转换）
        (setq pt1_WCS (trans pt1 1 0))
        
        ;; 使用grread实现动态拖动
        (princ "\n拖动到注记位置，点击确认: ")
        (setq gr (grread t 15 0))
        (while (eq (car gr) 5)
            (redraw)
            (setq pt2 (cadr gr))
            (DrawTempObjects pt1 pt2)  ; 始终从选择点pt1开始绘制引线
            (setq gr (grread t 15 0))
        )
        
        ;; 如果是左键点击，则确认位置
        (if (eq (car gr) 3)
            (progn
                (setq pt2 (cadr gr))
               
                ;; 根据全局变量决定是否互换X和Y值
                (if (= *ZXC-SWAPXY* 2)
                    (setq strlst (mapcar 'strcat '("X=" "Y=")
                                         (mapcar '(lambda (x) (rtos x 2 xsws)) (list (cadr pt1) (car pt1))))) ; 互换位置
                    (setq strlst (mapcar 'strcat '("X=" "Y=")
                                         (mapcar '(lambda (x) (rtos x 2 xsws)) (list (car pt1) (cadr pt1))))) ; 正常位置
                )
               
                (setq textlength (apply 'MAX (mapcar '(lambda (x) (LC:TextLength x)) strlst)))
                (setq pt3 (if (> (car pt2) (car pt1))
                              (polar pt2 0 (+ textlength 1))
                              (polar pt2 pi (+ textlength 1))
                          ))
               
                ; 转换所有点到WCS坐标用于实体创建（实体需要WCS坐标）
                (setq lst (list pt1_WCS (trans pt2 1 0) (trans pt3 1 0)))
               
                ; 白色文字（颜色代码7）
                (entmake (list '(0 . "TEXT") '(41 . 1.0) (cons 1 (car strlst))
                    (cons 10 (trans (polar (polar (if (>= (car pt2) (car pt1)) pt2 pt3) 0 0.5) (* 0.5 pi) (* texthigh 0.2)) 1 0))
                    (cons 40 texthigh) (cons 62 7)))
               
                (entmake (list '(0 . "TEXT") '(41 . 1.0) (cons 1 (cadr strlst))
                    (cons 10 (trans (polar (polar (if (>= (car pt2) (car pt1)) pt2 pt3) 0 0.5) (* 1.5 pi) (+ (* texthigh 0.2) texthigh)) 1 0))
                    (cons 40 texthigh) (cons 62 7)))
               
                ; 绿色引出线（颜色代码3）
                (entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity")
                    (cons 62 3)
                    '(100 . "AcDbPolyline") (cons 90 (length lst)))
                    (mapcar '(lambda (pt) (cons 10 pt)) lst)))
            )
        )
        (redraw) ; 清除临时图形
    )
    (setvar "TEXTSIZE" textsize-bak)
    (setvar "TEXTSTYLE" TEXTSTYLE-bak)
    (princ)
)
;;; ================================================================
;;  功能：将CAD图中某点移到指定坐标
;;  命令：ZZ改指定坐标
;;  说明：整图移动，注意 X Y 轴  天正坐标XY是互换
;;; ================================================================
(DEFUN C:ZZ改指定坐标 (/ oldPt newPt inputX inputY xOffset yOffset)
    ; 正常顺序输入，但内部对调使用
    (princ "\n请输入X(y)值<建筑坐标X>: ")
    (if (setq inputX (getreal))  ; 输入的X值，实际作为Y坐标
        (progn
            (princ "\n请输入Y(x)值<建筑坐标Y>: ")
            (if (setq inputY (getreal))  ; 输入的Y值，实际作为X坐标
                (progn
                    ; 关键修改：输入X→Y坐标，输入Y→X坐标
                    (setq newPt (list inputY inputX 0.0))  ; (实际X, 实际Y, 0)
                    
                    (princ "\n请选择需要修改坐标的原始点: ")
                    (if (setq oldPt (getpoint))
                        (progn
                            ; 显示坐标映射关系，让用户清晰了解转换情况
                            (princ (strcat "\n原始点坐标: X=" (rtos (car oldPt) 2 3)
                                           " Y=" (rtos (cadr oldPt) 2 3)))
                            (princ (strcat "\n您输入的X值: " (rtos inputX 2 3) " (将作为Y坐标)"))
                            (princ (strcat "\n您输入的Y值: " (rtos inputY 2 3) " (将作为X坐标)"))
                            (princ (strcat "\n转换后的目标坐标: X=" (rtos inputY 2 3)
                                           " Y=" (rtos inputX 2 3)))
                           
                            ; 计算偏移量（基于转换后的坐标）
                            (setq xOffset (- inputY (car oldPt)))  ; 输入Y作为X偏移
                            (setq yOffset (- inputX (cadr oldPt)))  ; 输入X作为Y偏移
                           
                            ; 移动所有对象，完成坐标调整
                            (command "_.SELECT" "ALL" "")
                            (command "_.MOVE" "_P" "" (list 0 0 0) (list xOffset yOffset 0))
                           
                            (princ "\n坐标系统已调整，X值已作为Y坐标，Y值已作为X坐标使用！")
                        )
                        (princ "\n未选择原始点，操作取消。")
                    )
                )
                (princ "\n未输入Y值，操作取消。")
            )
        )
        (princ "\n未输入X值，操作取消。")
    )
    (princ)
)
;;; ================================================================
;;  功能： 改坐标原点【X=0.000  Y=0.000】
;;  命令：ZZ改坐标原点
;;  说明：影响整图坐标
;;; ================================================================
(defun C:ZZ改坐标原点 (/ PT0 PT3 PTI)
  (setvar "OSMODE" 16383)
  (setq PT0 (getpoint "\n指定坐标系原点:"))
  (command "_.UCS" "_O" PT0)
  (initget "0,0")
  (if (setq PT3 (getpoint "\n输入参考点坐标<0,0>:"))
    (command "_.MOVE" "_ALL" "" PT3 "0,0")
  )
  ;; 坐标查询
  (while (setq PTI (getpoint "\n点击查询坐标<退出>:"))
    (princ (strcat "\rX=" (rtos (car PTI) 2 4) " Y=" (rtos (cadr PTI) 2 4)))
  )
  (command "_.UCS" "_W")  ; 恢复世界坐标系
  (princ)
)

lxl217114

谢谢分享源码