超级动态调整

20060510412 · 发表于 2022-4-30 16:27:36

本帖最后由 20060510412 于 2022-5-7 20:28 编辑

在既有源代码基础上进行了改进，源代码里面有原作者信息，在此表示感激。

1.支持对文字高度、标注比例、线型比例、填充比例、块缩放比例进行动态调整。
2.支持先选择对象后执行。
3.可以批量选择多个同类型图元（例如单行文本），然后同时动态调整这些文本的高度。ps：执行批量操作，需要首先选择所有的目标对象，然后再执行命令。

尘缘一生 · 发表于 2022-5-1 20:19:25

;;;duotu007 ver1.0 2012/9/6(原著)
;;;1028695446 ver2.0 2019/4/4(修改)
(defun c:tt (/ bl_update bl_update_time_batch boolean_typeofss ent error_do main_process main_process_batch ss text_update color text textent)
;启用错误处理之后，导致无法先选择后执行，具体原因还不得而知。
;(error_init 'error_do 1)
(defun error_do ()
(redraw)
(if text (entdel text));删除临时文字
(princ)
)
;;-------------------
(defun bl_update (tp bl);;子函数,更新比例为绝对值bl
(cond
((member tp '("REGION" "LWPOLYLINE" "LINE" "CIRCLE" "ARC"))
(vla-put-LinetypeScale obj bl);;设定线型比例
)
((= tp "HATCH")
(vla-put-PatternScale obj bl);;设定填充比例
)
((= tp "INSERT")
(vla-put-xscalefactor obj bl);;设定图块比例x
(vla-put-yscalefactor obj bl);;设定图块比例y
(vla-put-zscalefactor obj bl);;设定图块比例z
)
((member tp '("TEXT" "MTEXT"))
(vla-put-Height obj bl)
)
((wcmatch tp "*DIMENSION")
(vla-put-ScaleFactor obj bl)
)
)
)
;;---------------------------------
(defun bl_update_time_batch (list_ent list_bl bl / tp);;子函数,对选择集内的图元，批量更新比例为原始比例的bl倍
(setq tp (dxf1 (entget (nth 0 list_ent)) 0))
(cond
((member tp '("REGION" "LWPOLYLINE" "LINE" "CIRCLE" "ARC"))
(mapcar '(lambda (x y) (vla-put-LinetypeScale (en2obj x) (* y bl))) list_ent list_bl)
)
((= tp "HATCH")
(mapcar '(lambda (x y) (vla-put-PatternScale (en2obj x) (* y bl))) list_ent list_bl)
)
((= tp "INSERT")
(mapcar '(lambda (x y) (vla-put-xscalefactor (en2obj x) (* y bl))) list_ent (nth 0 list_bl))
(mapcar '(lambda (x y) (vla-put-yscalefactor (en2obj x) (* y bl))) list_ent (nth 1 list_bl))
(mapcar '(lambda (x y) (vla-put-zscalefactor (en2obj x) (* y bl))) list_ent (nth 2 list_bl))
)
((member tp '("TEXT" "MTEXT"))
(mapcar '(lambda (x y) (vla-put-Height (en2obj x) (* y bl))) list_ent list_bl)
)
((wcmatch tp "*DIMENSION")
;(vla-put-ScaleFactor obj bl)
(mapcar '(lambda (x y) (vla-put-ScaleFactor (en2obj x) (* y bl))) list_ent list_bl)
)
)
)
;;-------------------
(defun text_update (str / );;子函数,更新临时文字
(if color (princ) (setq color 1))
;(setq str (rtos bl))
(if text;文字显示
(progn
(setq textent (subst (cons 1 str) (assoc 1 textent) textent))
(setq textent (subst (cons 62 color) (assoc 62 textent) textent))
(setq textent (subst (cons 40 (/ (getvar "viewsize") 30)) (assoc 40 textent) textent))
;鼠标移动的时候，更新坐标，使其跟随鼠标移动；敲击键盘的时候，不更新坐标
(if (= a 5) (setq textent (subst (cons 10 aa) (assoc 10 textent) textent)))
;(if flag_dynamic (setq textent (subst (cons 10 aa)(assoc 10 textent) textent)));启用动态比例
(entmod textent)
);第二遍已有,修改内容
(progn
(entmake
(list
'(0 . "TEXT")
(cons 1 str)
;鼠标移动的时候，更新坐标，使其跟随鼠标移动；其他情况，坐标为图元的坐标
(if (= a 5) (cons 10 aa) (cons 10 pt0))
;(if flag_dynamic (cons 10 aa)(cons 10 pt0))
(cons 40 (/ (getvar "viewsize") 30));;字体大小,同视图比例相关
(cons 41 0.7) ;;字高
(cons 50 0);;字旋转角度
(cons 62 color)
)
)
(setq text (entlast) textent (entget text))
);第一遍文字不存在先生成
)
)
;判断选择集是否均为同一图元类型----------
(defun boolean_typeOfSs (ss str_type / ent flag index tp)
(setq flag T)
(setq index 0)
(while (and flag (setq ent (ssname ss index)))
(setq tp (dxf1 (entget ent) 0))
(if
(not
(if (= str_type "*DIMENSION")
(wcmatch tp "*DIMENSION")
(= tp str_type)
)
)
(setq flag nil)
)
(setq index (1+ index))
)
flag
)
;针对单一图元的处理流程-----------
(defun main_process (ent pt0 / a aa bl color elist flag_circulate flag_dynamic flag_secondclick mouse tp obj point_base)
(setq elist (entget ent))
(setq tp (dxf1 elist 0))
(setq obj (en2obj ent))
(setq flag_dynamic nil);;默认启用动态比例
(setq flag_secondClick nil) ;第二次鼠标左键，结束程序
(cond
;获得标注的全局比例
((wcmatch tp "*DIMENSION")
(if (= (setq bl (vla-get-ScaleFactor (en2obj ent))) nil) (setq bl 1))
)
((member tp '("TEXT" "MTEXT")) ;取文字高度值作为实际比例
(if (= (setq bl (dxf1 elist 40)) nil)
(setq bl 1)
)
)
((member tp '("REGION" "LWPOLYLINE" "LINE" "CIRCLE" "ARC"))
(if (= (setq bl (dxf1 elist 48)) nil)
(setq bl 1)
)
)
((member tp '("HATCH" "INSERT"))
(setq bl (dxf1 elist 41) flag_dynamic nil)
);;注意,这要关闭,因为初始不能为0
(t (alert "\n 选择错误..."))
)
(if bl
(progn
(setq flag_circulate T)
(while flag_circulate
(setq mouse (grread T 12 0))
(setq a (car mouse) aa (cadr mouse))
(cond
;按键d或者D字高增加一倍
((and (= 2 a) (or (= 100 aa) (= 68 aa))) ;2表示键盘输入,'(2 100)表示d键,'(2 68)表示D键
(setq flag_dynamic nil);;关闭动态比例
(setq bl (* bl 2))
(bl_update tp bl)
(text_update (rtos bl));;更新文字
)
;按键w或者W字高缩小一倍
((and (= 2 a) (or (= 120 aa) (= 88 aa))) ;2表示键盘输入,'(2 120)表示x键,'(2 88)表示X键
(setq flag_dynamic nil);;关闭动态比例
(setq bl (/ bl 2))
;(if(= tp "INSERT")(if (< 0 (1- bl))(setq bl (1- bl)))(setq bl (/ bl 2)));;块单独区分,加减更适用
;(if (< bL 0.01)(setq bL 0.01));;防止比例为太杂****************************************
(bl_update tp bl)
(text_update (rtos bl));;更新文字
)
;按键e或者E指定比例
((and (= 2 a) (or (= 101 aa) (= 69 aa)))
(setq flag_dynamic nil);;关闭动态比例
(setq bl (getreal "\n 指定缩放比例:"))
(bl_update tp bl)
(text_update (rtos bl));;更新文字
)
((and (= a 5) flag_dynamic);鼠标移动和启用动态比例
(redraw)
(grdraw point_base aa 1);画向量
(setq bl (distance point_base aa))
(cond
((and (< 0 bl) (< bl 0.1))
(setq bl (* (fix (/ bl 0.01)) 0.01) color 1);规范0~1之间取值,模数=0.1
)
((and (<= 0.1 bl) (< bl 1))
(setq bl (* (fix (/ bl 0.1)) 0.1) color 2);规范0~1之间取值,模数=0.1
)
((and(<= 1 bl) (< bl 10))
(setq bl (* (fix (/ bl 0.5)) 0.5) color 3);规范1~10之间取值,模数=0.5
)
((and(<= 10 bl) (< bl 20))
(setq bl (fix bl) color 4);规范10~20之间取值,模数=1
)
((and(<= 20 bl) (< bl 100))
(setq bl (* (fix (/ bl 5)) 5) color 4);规范20~100之间取值,模数=5
)
((<= 100 bl)
(setq bl (* (fix (/ bl 10)) 10) color 6);规范20~100之间取值,模数=10
)
((= 0 bl) (setq bl 1 color 6))
)
(bl_update tp bl);;更新比例
(text_update (rtos bl));;更新文字
)
((and (= a 5) (not flag_dynamic));鼠标移动,不启用动态比例
(text_update (strcat "当前比例：" (rtos bl 2 2) "\n【放大(D)/缩小(X)/指定(E)/动态(左键)/退出(空格)】"));;更新文字
)
((= a 3) ;鼠标左键,启用动态比例
(setq flag_dynamic T)
(setq point_base aa)
(if (= flag_secondClick nil) ;识别第二次点击鼠标左键
(setq flag_secondClick T)
(setq flag_circulate nil)
)
)
((or
(= 25 a) (= 11 a) ;右键
(and (= a 2) (= aa 13));回车
(and (= a 2) (= aa 32));或空格
)
(setq flag_circulate nil)
)
)
)
)
(alert "\n 比例不能为0")
)
(redraw)
(if text (entdel text));删除临时文字
(princ)
)
;对选择集的批量处理，以相对的缩放倍数为基准
(defun main_process_batch (ss pt0 / a aa bl color flag_circulate flag_dynamic flag_secondclick list_bl list_ent mouse tp point_base)
(setq list_ent (ss-enlst ss))
(setq tp (dxf1 (entget (nth 0 list_ent)) 0))
(cond
((member tp '("REGION" "LWPOLYLINE" "LINE" "CIRCLE" "ARC"))
(setq list_bl (mapcar '(lambda (x) (vla-get-LinetypeScale (en2obj x))) list_ent))
)
((= tp "HATCH")
(setq list_bl (mapcar '(lambda (x) (vla-get-PatternScale (en2obj x))) list_ent))
)
((= tp "INSERT")
(setq list_bl
(list
(mapcar '(lambda (x) (vla-get-xscalefactor (en2obj x))) list_ent)
(mapcar '(lambda (x) (vla-get-yscalefactor (en2obj x))) list_ent)
(mapcar '(lambda (x) (vla-get-zscalefactor (en2obj x))) list_ent)
)
)
)
((member tp '("HATCH" "INSERT"))
(setq list_bl (mapcar '(lambda (x) (vla-get-Height (en2obj x))) list_ent))
)
((wcmatch tp "*DIMENSION")
;(vla-put-ScaleFactor obj bl)
(setq list_bl (mapcar '(lambda (x) (vla-get-ScaleFactor (en2obj x))) list_ent))
)
)
(setq flag_dynamic nil);;默认启用动态比例
(setq flag_secondClick nil) ;第二次鼠标左键，结束程序
(setq bl 1)
(setq flag_circulate T)
(while flag_circulate
(setq mouse (grread T 12 0))
(setq a (car mouse) aa (cadr mouse))
(cond
;按键q或者Q字高增加一倍
((and (= 2 a) (or (= 100 aa) (= 68 aa))) ;2表示键盘输入,'(2 100)表示d键,'(2 68)表示D键
(setq flag_dynamic nil);;关闭动态比例
(setq bl (* bl 2))
(bl_update_time_batch list_ent list_bl bl)
(text_update (rtos bl));;更新文字
)
;按键w或者W字高缩小一倍
((and (= 2 a) (or (= 120 aa) (= 88 aa))) ;2表示键盘输入,'(2 120)表示x键,'(2 88)表示X键
(setq flag_dynamic nil);;关闭动态比例
(setq bl (/ bl 2))
;(if(= tp "INSERT")(if (< 0 (1- bl))(setq bl (1- bl)))(setq bl (/ bl 2)));;块单独区分,加减更适用
;(if (< bL 0.01)(setq bL 0.01));;防止比例为太杂****************************************
(bl_update_time_batch list_ent list_bl bl)
(text_update (rtos bl));;更新文字
)
;按键e或者E指定比例
((and (= 2 a) (or (= 101 aa) (= 69 aa)))
(setq flag_dynamic nil);;关闭动态比例
(setq bl (getreal "\n 指定缩放比例:"))
(bl_update_time_batch list_ent list_bl bl)
(text_update (rtos bl));;更新文字
)
((and(= a 5) flag_dynamic);鼠标移动和启用动态比例
(redraw)
(grdraw point_base aa 1);画向量
(setq bl (distance point_base aa))
(cond
((and (< 0 bl) (< bl 0.1))
(setq bl (* (fix (/ bl 0.01)) 0.01) color 1);规范0~1之间取值,模数=0.1
)
((and (<= 0.1 bl) (< bl 1))
(setq bl (* (fix (/ bl 0.1)) 0.1) color 2);规范0~1之间取值,模数=0.1
)
((and (<= 1 bl) (< bl 10))
(setq bl (* (fix (/ bl 0.5)) 0.5) color 3);规范1~10之间取值,模数=0.5
)
((and (<= 10 bl) (< bl 20))
(setq bl (fix bl) color 4);规范10~20之间取值,模数=1
)
((and (<= 20 bl) (< bl 100))
(setq bl (* (fix (/ bl 5)) 5) color 4);规范20~100之间取值,模数=5
)
((<= 100 bl)
(setq bl (* (fix (/ bl 10)) 10) color 6);规范20~100之间取值,模数=10
)
((= 0 bl) (setq bl 1 color 6))
)
(bl_update_time_batch list_ent list_bl bl);;更新比例
(text_update (rtos bl));;更新文字
)
((and (= a 5) (not flag_dynamic));鼠标移动,不启用动态比例
(text_update (strcat "当前变化倍数：" (rtos bl 2 2) "\n【放大(D)/缩小(X)/指定(E)/动态(左键)/退出(空格)】"));;更新文字
)
((= a 3) ;鼠标左键,启用动态比例
(setq flag_dynamic T)
(setq point_base aa)
(if (= flag_secondClick nil) ;识别第二次点击鼠标左键
(setq flag_secondClick T)
(setq flag_circulate nil)
)
)
((or
(= 25 a) (= 11 a) ;右键
(and (= a 2) (= aa 13));回车
(and (= a 2) (= aa 32));或空格
)
(setq flag_circulate nil)
)
)
)
(redraw)
(if text (entdel text));删除临时文字
(princ)
)
;;!!!!!!!!!!!主程序------------------
(princ (slmsg "\n 选择修改比例的实体" "\n 選擇修改比例的實體"))
(setq ss (ssget ":S"))
(cond
((= (sslength ss) 1)
(setq nam (ssname ss 0))
(main_process nam (e-mid nam))
)
((> (sslength ss) 1)
(if
(or
(boolean_typeOfSs ss "*DIMENSION")
(boolean_typeOfSs ss "TEXT")
(boolean_typeOfSs ss "MTEXT")
(boolean_typeOfSs ss "REGION")
(boolean_typeOfSs ss "LWPOLYLINE")
(boolean_typeOfSs ss "LINE")
(boolean_typeOfSs ss "CIRCLE")
(boolean_typeOfSs ss "ARC")
(boolean_typeOfSs ss "HATCH")
(boolean_typeOfSs ss "INSERT")
)
(main_process_batch ss '(0 0 0))
(main_process (ssname ss 0) '(0 0 0))
)
)
)
)

;;;duotu007 ver1.0 2012/9/6(原著) 
;;;1028695446   ver2.0 2019/4/4(修改) 
(defun c:tt (/ bl_update bl_update_time_batch boolean_typeofss ent error_do main_process main_process_batch ss text_update color text textent) 
  ;启用错误处理之后，导致无法先选择后执行，具体原因还不得而知。 
  ;(error_init 'error_do 1) 
  (defun error_do () 
    (redraw) 
    (if text (entdel text));删除临时文字 
    (princ) 
  ) 
  ;;------------------- 
  (defun bl_update (tp bl);;子函数,更新比例为绝对值bl 
    (cond 
      ((member tp '("REGION" "LWPOLYLINE" "LINE" "CIRCLE" "ARC")) 
        (vla-put-LinetypeScale obj bl);;设定线型比例 
      ) 
      ((= tp "HATCH") 
        (vla-put-PatternScale obj bl);;设定填充比例 
      ) 
      ((= tp "INSERT") 
        (vla-put-xscalefactor obj bl);;设定图块比例x 
        (vla-put-yscalefactor obj bl);;设定图块比例y 
        (vla-put-zscalefactor obj bl);;设定图块比例z 
      ) 
      ((member tp '("TEXT" "MTEXT")) 
        (vla-put-Height obj bl) 
      ) 
      ((wcmatch tp "*DIMENSION") 
        (vla-put-ScaleFactor obj bl) 
      ) 
    ) 
  ) 
  ;;--------------------------------- 
  (defun bl_update_time_batch (list_ent list_bl bl / tp);;子函数,对选择集内的图元，批量更新比例为原始比例的bl倍 
    (setq tp (dxf1 (entget (nth 0 list_ent)) 0)) 
    (cond 
      ((member tp '("REGION" "LWPOLYLINE" "LINE" "CIRCLE" "ARC")) 
        (mapcar '(lambda (x y) (vla-put-LinetypeScale (en2obj x) (* y bl))) list_ent list_bl) 
      ) 
      ((= tp "HATCH") 
        (mapcar '(lambda (x y) (vla-put-PatternScale (en2obj x) (* y bl))) list_ent list_bl) 
      ) 
      ((= tp "INSERT") 
        (mapcar '(lambda (x y) (vla-put-xscalefactor (en2obj x) (* y bl))) list_ent (nth 0 list_bl)) 
        (mapcar '(lambda (x y) (vla-put-yscalefactor (en2obj x) (* y bl))) list_ent (nth 1 list_bl)) 
        (mapcar '(lambda (x y) (vla-put-zscalefactor (en2obj x) (* y bl))) list_ent (nth 2 list_bl)) 
      ) 
      ((member tp '("TEXT" "MTEXT")) 
        (mapcar '(lambda (x y) (vla-put-Height (en2obj x) (* y bl))) list_ent list_bl) 
      ) 
      ((wcmatch tp "*DIMENSION") 
        ;(vla-put-ScaleFactor obj bl) 
        (mapcar '(lambda (x y) (vla-put-ScaleFactor (en2obj x) (* y bl))) list_ent list_bl) 
      ) 
    ) 
  ) 
  ;;------------------- 
  (defun text_update (str / );;子函数,更新临时文字 
    (if color (princ) (setq color 1)) 
    ;(setq str (rtos bl)) 
    (if text;文字显示 
      (progn 
        (setq textent (subst (cons 1 str)   (assoc 1  textent) textent)) 
        (setq textent (subst (cons 62 color) (assoc 62 textent) textent)) 
        (setq textent (subst (cons 40 (/ (getvar "viewsize") 30)) (assoc 40 textent) textent)) 
        ;鼠标移动的时候，更新坐标，使其跟随鼠标移动；敲击键盘的时候，不更新坐标 
        (if (= a 5) (setq textent (subst (cons 10 aa) (assoc 10 textent) textent))) 
        ;(if flag_dynamic (setq textent (subst (cons 10 aa)(assoc 10 textent) textent)));启用动态比例 
        (entmod textent) 
      );第二遍已有,修改内容 
      (progn 
        (entmake 
          (list 
            '(0 . "TEXT") 
            (cons 1 str) 
            ;鼠标移动的时候，更新坐标，使其跟随鼠标移动；其他情况，坐标为图元的坐标 
            (if (= a 5) (cons 10 aa) (cons 10 pt0)) 
            ;(if flag_dynamic (cons 10 aa)(cons 10 pt0)) 
            (cons 40 (/ (getvar "viewsize") 30));;字体大小,同视图比例相关 
            (cons 41 0.7) ;;字高 
            (cons 50 0);;字旋转角度 
            (cons 62 color) 
          ) 
        ) 
        (setq text (entlast) textent (entget text)) 
      );第一遍文字不存在先生成 
    ) 
  ) 
  ;判断选择集是否均为同一图元类型---------- 
  (defun boolean_typeOfSs (ss str_type / ent flag index tp) 
    (setq flag T) 
    (setq index 0) 
    (while (and flag (setq ent (ssname ss index))) 
      (setq tp (dxf1 (entget ent) 0)) 
      (if 
        (not 
          (if (= str_type "*DIMENSION") 
            (wcmatch tp "*DIMENSION") 
            (= tp str_type) 
          ) 
        ) 
        (setq flag nil) 
      ) 
      (setq index (1+ index)) 
    ) 
    flag 
  ) 
  ;针对单一图元的处理流程----------- 
  (defun main_process (ent pt0 / a aa bl color elist flag_circulate flag_dynamic flag_secondclick mouse tp obj point_base) 
    (setq elist (entget ent)) 
    (setq tp (dxf1 elist 0)) 
    (setq obj (en2obj ent)) 
    (setq flag_dynamic nil);;默认启用动态比例 
    (setq flag_secondClick nil) ;第二次鼠标左键，结束程序 
    (cond 
      ;获得标注的全局比例 
      ((wcmatch tp "*DIMENSION") 
        (if (= (setq bl (vla-get-ScaleFactor (en2obj ent))) nil) (setq bl 1)) 
      ) 
      ((member tp '("TEXT" "MTEXT")) ;取文字高度值作为实际比例 
        (if (= (setq bl (dxf1 elist 40)) nil) 
          (setq bl 1) 
        ) 
      )   
      ((member tp '("REGION" "LWPOLYLINE" "LINE" "CIRCLE" "ARC")) 
        (if (= (setq bl (dxf1 elist 48)) nil) 
          (setq bl 1) 
        ) 
      ) 
       
      ((member tp '("HATCH" "INSERT")) 
        (setq bl (dxf1 elist 41) flag_dynamic nil) 
      );;注意,这要关闭,因为初始不能为0 
      (t (alert "\n 选择错误...")) 
    ) 
    (if bl 
      (progn 
        (setq flag_circulate T) 
        (while flag_circulate 
          (setq mouse (grread T 12 0)) 
          (setq a (car mouse) aa (cadr mouse)) 
          (cond 
            ;按键d或者D字高增加一倍 
            ((and (= 2 a) (or (= 100 aa) (= 68 aa)))  ;2表示键盘输入,'(2 100)表示d键,'(2 68)表示D键 
              (setq flag_dynamic nil);;关闭动态比例 
              (setq bl (* bl 2)) 
              (bl_update tp bl) 
              (text_update (rtos bl));;更新文字 
            ) 
            ;按键w或者W字高缩小一倍 
            ((and (= 2 a) (or (= 120 aa) (= 88 aa)))  ;2表示键盘输入,'(2 120)表示x键,'(2 88)表示X键 
              (setq flag_dynamic nil);;关闭动态比例 
              (setq bl (/ bl 2)) 
              ;(if(= tp "INSERT")(if (< 0 (1- bl))(setq bl (1- bl)))(setq bl (/ bl 2)));;块单独区分,加减更适用 
              ;(if (< bL 0.01)(setq bL 0.01));;防止比例为太杂**************************************** 
              (bl_update tp bl) 
              (text_update (rtos bl));;更新文字 
            ) 
            ;按键e或者E指定比例 
            ((and (= 2 a) (or (= 101 aa) (= 69 aa))) 
              (setq flag_dynamic nil);;关闭动态比例 
              (setq bl (getreal "\n 指定缩放比例:")) 
              (bl_update tp bl) 
              (text_update (rtos bl));;更新文字 
            ) 
            ((and (= a 5) flag_dynamic);鼠标移动和启用动态比例 
              (redraw) 
              (grdraw point_base aa 1);画向量 
              (setq bl (distance point_base aa)) 
              (cond 
                ((and (< 0 bl) (< bl 0.1)) 
                  (setq bl (* (fix (/ bl 0.01)) 0.01) color 1);规范0~1之间取值,模数=0.1 
                ) 
                ((and (<= 0.1 bl) (< bl 1)) 
                  (setq bl (* (fix (/ bl 0.1)) 0.1) color 2);规范0~1之间取值,模数=0.1 
                ) 
                ((and(<= 1 bl) (< bl 10)) 
                  (setq bl (* (fix (/ bl 0.5)) 0.5) color 3);规范1~10之间取值,模数=0.5 
                ) 
                ((and(<= 10 bl) (< bl 20)) 
                  (setq bl (fix bl) color 4);规范10~20之间取值,模数=1 
                ) 
                ((and(<= 20 bl) (< bl 100)) 
                  (setq bl (* (fix (/ bl 5)) 5) color 4);规范20~100之间取值,模数=5 
                ) 
                ((<= 100 bl) 
                  (setq bl (* (fix (/ bl 10)) 10) color 6);规范20~100之间取值,模数=10 
                ) 
                ((= 0 bl) (setq bl 1 color 6)) 
              ) 
              (bl_update tp bl);;更新比例 
              (text_update (rtos bl));;更新文字 
            ) 
            ((and (= a 5) (not flag_dynamic));鼠标移动,不启用动态比例 
              (text_update (strcat "当前比例：" (rtos bl 2 2) "\n【放大(D)/缩小(X)/指定(E)/动态(左键)/退出(空格)】"));;更新文字 
            ) 
            ((= a 3)  ;鼠标左键,启用动态比例 
              (setq flag_dynamic T) 
              (setq point_base aa) 
              (if (= flag_secondClick nil)  ;识别第二次点击鼠标左键 
                (setq flag_secondClick T) 
                (setq flag_circulate nil) 
              ) 
            ) 
            ((or 
               (= 25 a) (= 11 a) ;右键 
               (and (= a 2) (= aa 13));回车 
               (and (= a 2) (= aa 32));或空格 
             ) 
              (setq flag_circulate nil) 
            ) 
          ) 
        ) 
      ) 
      (alert "\n 比例不能为0") 
    ) 
    (redraw) 
    (if text (entdel text));删除临时文字 
    (princ) 
  ) 
  ;对选择集的批量处理，以相对的缩放倍数为基准 
  (defun main_process_batch (ss pt0 / a aa bl color flag_circulate flag_dynamic flag_secondclick list_bl list_ent mouse tp point_base) 
    (setq list_ent (ss-enlst ss)) 
    (setq tp (dxf1 (entget (nth 0 list_ent)) 0)) 
    (cond 
      ((member tp '("REGION" "LWPOLYLINE" "LINE" "CIRCLE" "ARC")) 
        (setq list_bl (mapcar '(lambda (x) (vla-get-LinetypeScale (en2obj x))) list_ent)) 
      ) 
      ((= tp "HATCH") 
        (setq list_bl (mapcar '(lambda (x) (vla-get-PatternScale (en2obj x))) list_ent)) 
      ) 
      ((= tp "INSERT") 
        (setq list_bl 
          (list 
            (mapcar '(lambda (x) (vla-get-xscalefactor (en2obj x))) list_ent) 
            (mapcar '(lambda (x) (vla-get-yscalefactor (en2obj x))) list_ent) 
            (mapcar '(lambda (x) (vla-get-zscalefactor (en2obj x))) list_ent) 
          ) 
        ) 
      ) 
      ((member tp '("HATCH" "INSERT")) 
        (setq list_bl (mapcar '(lambda (x) (vla-get-Height (en2obj x))) list_ent)) 
      ) 
      ((wcmatch tp "*DIMENSION") 
        ;(vla-put-ScaleFactor obj bl)         
        (setq list_bl (mapcar '(lambda (x) (vla-get-ScaleFactor (en2obj x))) list_ent)) 
      ) 
    ) 
    (setq flag_dynamic nil);;默认启用动态比例 
    (setq flag_secondClick nil) ;第二次鼠标左键，结束程序 
    (setq bl 1) 
    (setq flag_circulate T) 
    (while flag_circulate 
      (setq mouse (grread T 12 0)) 
      (setq a (car mouse) aa (cadr mouse)) 
      (cond 
        ;按键q或者Q字高增加一倍 
        ((and (= 2 a) (or (= 100 aa) (= 68 aa)))  ;2表示键盘输入,'(2 100)表示d键,'(2 68)表示D键 
          (setq flag_dynamic nil);;关闭动态比例 
          (setq bl (* bl 2)) 
          (bl_update_time_batch list_ent list_bl bl) 
          (text_update (rtos bl));;更新文字 
        ) 
        ;按键w或者W字高缩小一倍 
        ((and (= 2 a) (or (= 120 aa) (= 88 aa)))  ;2表示键盘输入,'(2 120)表示x键,'(2 88)表示X键 
          (setq flag_dynamic nil);;关闭动态比例 
          (setq bl (/ bl 2)) 
          ;(if(= tp "INSERT")(if (< 0 (1- bl))(setq bl (1- bl)))(setq bl (/ bl 2)));;块单独区分,加减更适用 
          ;(if (< bL 0.01)(setq bL 0.01));;防止比例为太杂**************************************** 
          (bl_update_time_batch list_ent list_bl bl) 
          (text_update (rtos bl));;更新文字 
        ) 
        ;按键e或者E指定比例 
        ((and (= 2 a) (or (= 101 aa) (= 69 aa))) 
          (setq flag_dynamic nil);;关闭动态比例 
          (setq bl (getreal "\n 指定缩放比例:")) 
          (bl_update_time_batch list_ent list_bl bl) 
          (text_update (rtos bl));;更新文字 
        ) 
        ((and(= a 5) flag_dynamic);鼠标移动和启用动态比例 
          (redraw) 
          (grdraw point_base aa 1);画向量 
          (setq bl (distance point_base aa)) 
          (cond 
            ((and (< 0 bl) (< bl 0.1)) 
              (setq bl (* (fix (/ bl 0.01)) 0.01) color 1);规范0~1之间取值,模数=0.1 
            ) 
            ((and (<= 0.1 bl) (< bl 1)) 
              (setq bl (* (fix (/ bl 0.1)) 0.1) color 2);规范0~1之间取值,模数=0.1 
            ) 
            ((and (<= 1 bl) (< bl 10)) 
              (setq bl (* (fix (/ bl 0.5)) 0.5) color 3);规范1~10之间取值,模数=0.5 
            ) 
            ((and (<= 10 bl) (< bl 20)) 
              (setq bl (fix bl) color 4);规范10~20之间取值,模数=1 
            ) 
            ((and (<= 20 bl) (< bl 100)) 
              (setq bl (* (fix (/ bl 5)) 5) color 4);规范20~100之间取值,模数=5 
            ) 
            ((<= 100 bl) 
              (setq bl (* (fix (/ bl 10)) 10) color 6);规范20~100之间取值,模数=10 
            ) 
            ((= 0 bl) (setq bl 1 color 6)) 
          ) 
          (bl_update_time_batch list_ent list_bl bl);;更新比例 
          (text_update (rtos bl));;更新文字 
        ) 
        ((and (= a 5) (not flag_dynamic));鼠标移动,不启用动态比例 
          (text_update (strcat "当前变化倍数：" (rtos bl 2 2) "\n【放大(D)/缩小(X)/指定(E)/动态(左键)/退出(空格)】"));;更新文字 
        ) 
        ((= a 3)  ;鼠标左键,启用动态比例 
          (setq flag_dynamic T) 
          (setq point_base aa) 
          (if (= flag_secondClick nil)  ;识别第二次点击鼠标左键 
            (setq flag_secondClick T) 
            (setq flag_circulate nil) 
          ) 
        ) 
        ((or 
           (= 25 a) (= 11 a) ;右键 
           (and (= a 2) (= aa 13));回车 
           (and (= a 2) (= aa 32));或空格 
         ) 
          (setq flag_circulate nil) 
        ) 
      ) 
    ) 
    (redraw) 
    (if text (entdel text));删除临时文字 
    (princ) 
  ) 
  ;;!!!!!!!!!!!主程序------------------ 
  (princ (slmsg "\n 选择修改比例的实体" "\n 選擇修改比例的實體")) 
  (setq ss (ssget ":S")) 
  (cond 
    ((= (sslength ss) 1) 
      (setq nam (ssname ss 0)) 
      (main_process nam (e-mid nam)) 
    ) 
    ((> (sslength ss) 1) 
      (if 
        (or 
          (boolean_typeOfSs ss "*DIMENSION") 
          (boolean_typeOfSs ss "TEXT") 
          (boolean_typeOfSs ss "MTEXT") 
          (boolean_typeOfSs ss "REGION") 
          (boolean_typeOfSs ss "LWPOLYLINE") 
          (boolean_typeOfSs ss "LINE") 
          (boolean_typeOfSs ss "CIRCLE") 
          (boolean_typeOfSs ss "ARC") 
          (boolean_typeOfSs ss "HATCH") 
          (boolean_typeOfSs ss "INSERT") 
        ) 
        (main_process_batch ss '(0 0 0)) 
        (main_process (ssname ss 0) '(0 0 0)) 
      ) 
    ) 
  ) 
)

选择集处理部分，测试不成功，还有，实体类型支持过少点，剩余不支持类型可以整合

(command "scale" ss "" "non" pt0 pause) 思路处理如何？

1028695446 · 发表于 2022-5-4 13:08:02

额。。。。。。。。。。
(setq list_ent (pickset_2list ss))缺函数 pickset_2list

;选择集与对象名表互转
(defun pickset_2list (ss / enlst)
(cond
((= (type ss) 'PICKSET)
(vl-remove-if-not '(lambda (x) (= (type x) 'ENAME)) (mapcar 'cadr (ssnamex SS)))
)
((= (type ss) 'LIST)
(setq enlst (ssadd))
(last (mapcar '(lambda (x) (ssadd x enlst)) ss))
)
)
)

andyzha · 发表于 2022-5-8 11:50:37

本帖最后由 andyzha 于 2022-5-8 11:54 编辑

20060510412 发表于 2022-5-7 20:24
在源代码中搜索这个文本所在的行，把那一行注释掉就行了

我已经删掉了，但是选择对象后还会间断一下，不是马上就进入缩放状态，如何修改中间的停顿呢？应该是为了显示这段临时文字做的停顿。

个人觉得第一个临时文字有些赘余，显示缩放比例的临时文字应该保留，本来这个程序就是为了集多种对象缩放为一个命令的超级调整，应该保持简洁高效的风格，一针见血，直达操作的目的本源，期待你的后期优化。

cj52000 · 发表于 2022-4-30 18:06:55

谢谢，挺好用的，我CAD调整图案填充的时候不动态显示

wrf610051 · 发表于 2022-5-1 07:42:01

很好，谢谢！

uualice2020 · 发表于 2022-5-1 08:31:25

已下载用用看

p-3-ianlcc · 发表于 2022-5-1 09:33:58

很不錯，謝謝你的分享！

趣意人生 · 发表于 2022-5-1 11:40:05

謝謝分享！

ynhh · 发表于 2022-5-1 17:18:29

本帖最后由 ynhh 于 2022-5-1 17:21 编辑

单行文字也只能处理一个
不能如你动画中的可框选啊
不能多选就意义不大了
你说的第3条无法做到，请你再看看

20060510412 · 发表于 2022-5-1 17:24:14

本帖最后由 20060510412 于 2022-5-1 17:28 编辑

ynhh 发表于 2022-5-1 17:18
单行文字也只能处理一个
不能如你动画中的可框选啊
不能多选就意义不大了

批量处理，需要先选择，再执行命令。

主要是考虑到选择同类型的图元，手工不容易做到。
将选择动作放在执行命令之前，也可以方便使用小菜选择易之类的插件，进行批量选取。

江南十笑 · 发表于 2022-5-1 22:08:18

66666666666666666

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

[源码] 超级动态调整

本帖子中包含更多资源

评分