[LISP程序]：详图比例设定、复原

zdarc · 发表于 2002-9-3 23:29:46

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

xt1命令，详图比例设定，根据比例自动放缩详图，按1:100出图比例布图。
xt2命令，详图比例复原，根据比例复原详图为1：1，方便修改。

[FONT=courier new]
;;详图比例设定
(defun c:xt1 (/ pt1 pt2 ss df q0 vh i lt e bl pt)
(if (and (setq pt1 (getpoint "\n窗口的第一点<退出>: "))
(setq pt2 (getcorner pt1 "\n窗口的第二点<退出>: "))
(setq ss (ssget "_w" pt1 pt2))
)
(progn
(xdrx_begin)
(if (setq vh (ssget "w" pt1 pt2 (list (cons 0 "DIMENSION"))))
(progn
(setq bl (substr (cdr (assoc 3 (entget (ssname vh 0)))) 5 3))
(setq df (getint (strcat "\n请输入详图比例 <1:" bl "> 1:")))
(if (null df)
(setq df (* 0.01 (atoi bl)))
(setq df (* 0.01 df))
)
(setq i 0)
(while (< i (sslength vh))
(setq lt (entget (ssname vh i)))
(setq e (cdr (assoc 3 lt)))
(command "dim1" "res" e)
(setvar "dimlfac" df)
(setvar "dimscale" 1)
(command "dim1" "update" (cdr (assoc -1 lt)) "")
(setq i (+ 1 i))
)
)
(setq df (* 0.01 (getint "\n请输入详图比例 <退出> 1: ")))
)
(setq q0 (xdrx_entity_box ss)
q0 (xdrx_midp (car q0) (cadr q0))
)
(command "scale" ss "" q0 (/ 1 df))
(if
(setq pt (xdrx_dragssmove "\n点取要移到的位置 <不移动>:" ss q0))
(command ".move" ss "" q0 pt)
)
(xdrx_end)
)
)
(princ)
)
;;详图比例恢复
(defun c:xt2 (/ pt1 pt2 ss df q0 vh i lt e bl pt)
(if (and (setq pt1 (getpoint "\n窗口的第一点<退出>: "))
(setq pt2 (getcorner pt1 "\n窗口的第二点<退出>: "))
(setq ss (ssget "_w" pt1 pt2))
)
(progn
(xdrx_begin)
(if (setq vh (ssget "w" pt1 pt2 (list (cons 0 "DIMENSION"))))
(progn
(setq bl (substr (cdr (assoc 3 (entget (ssname vh 0)))) 5 3))
(setq df (getint (strcat "\n请输入详图比例 <1:" bl "> 1:")))
(if (null df)
(setq df (* 0.01 (atoi bl)))
(setq df (* 0.01 df))
)
(setq i 0)
(while (< i (sslength vh))
(setq lt (entget (ssname vh i)))
(setq e (cdr (assoc 3 lt)))
(command "dim1" "res" e)
(setvar "dimlfac" 1)
(setvar "dimscale" df)
(command "dim1" "update" (cdr (assoc -1 lt)) "")
(setq i (+ 1 i))
)
)
(setq df (* 0.01 (getint "\n请输入详图比例 <退出> 1: ")))
)
(setq q0 (xdrx_entity_box ss)
q0 (xdrx_midp (car q0) (cadr q0))
)
(command "scale" ss "" q0 df)
(if
(setq pt (xdrx_dragssmove "\n点取要移到的位置 <不移动>:" ss q0))
(command ".move" ss "" q0 pt)
)
(xdrx_end)
)
)
(princ)
)[/FONT]

[FONT=courier new] 
;;详图比例设定 
(defun c:xt1 (/ pt1 pt2 ss df q0 vh i lt e bl pt) 
  (if (and (setq pt1 (getpoint "\n窗口的第一点<退出>: ")) 
           (setq pt2 (getcorner pt1 "\n窗口的第二点<退出>: ")) 
           (setq ss (ssget "_w" pt1 pt2)) 
      ) 
    (progn 
      (xdrx_begin) 
      (if (setq vh (ssget "w" pt1 pt2 (list (cons 0 "DIMENSION")))) 
        (progn 
          (setq bl (substr (cdr (assoc 3 (entget (ssname vh 0)))) 5 3)) 
          (setq df (getint (strcat "\n请输入详图比例 <1:" bl "> 1:"))) 
          (if (null df) 
            (setq df (* 0.01 (atoi bl))) 
            (setq df (* 0.01 df)) 
          ) 
          (setq i 0) 
          (while (
            (setq lt (entget (ssname vh i))) 
            (setq e (cdr (assoc 3 lt))) 
            (command "dim1" "res" e) 
            (setvar "dimlfac" df) 
            (setvar "dimscale" 1) 
            (command "dim1" "update" (cdr (assoc -1 lt)) "") 
            (setq i (+ 1 i)) 
          ) 
        ) 
        (setq df (* 0.01 (getint "\n请输入详图比例 <退出> 1: "))) 
      ) 
      (setq q0 (xdrx_entity_box ss) 
            q0 (xdrx_midp (car q0) (cadr q0)) 
      ) 
      (command "scale" ss "" q0 (/ 1 df)) 
      (if 
        (setq pt (xdrx_dragssmove "\n点取要移到的位置 <不移动>:" ss q0)) 
         (command ".move" ss "" q0 pt) 
      ) 
      (xdrx_end) 
    ) 
  ) 
  (princ) 
) 
;;详图比例恢复 
(defun c:xt2 (/ pt1 pt2 ss df q0 vh i lt e bl pt) 
  (if (and (setq pt1 (getpoint "\n窗口的第一点<退出>: ")) 
           (setq pt2 (getcorner pt1 "\n窗口的第二点<退出>: ")) 
           (setq ss (ssget "_w" pt1 pt2)) 
      ) 
    (progn 
      (xdrx_begin) 
      (if (setq vh (ssget "w" pt1 pt2 (list (cons 0 "DIMENSION")))) 
        (progn 
          (setq bl (substr (cdr (assoc 3 (entget (ssname vh 0)))) 5 3)) 
          (setq df (getint (strcat "\n请输入详图比例 <1:" bl ">  1:"))) 
          (if (null df) 
            (setq df (* 0.01 (atoi bl))) 
            (setq df (* 0.01 df)) 
          ) 
          (setq i 0) 
          (while (
            (setq lt (entget (ssname vh i))) 
            (setq e (cdr (assoc 3 lt))) 
            (command "dim1" "res" e) 
            (setvar "dimlfac" 1) 
            (setvar "dimscale" df) 
            (command "dim1" "update" (cdr (assoc -1 lt)) "") 
            (setq i (+ 1 i)) 
          ) 
        ) 
        (setq df (* 0.01 (getint "\n请输入详图比例 <退出> 1: "))) 
      ) 
      (setq q0 (xdrx_entity_box ss) 
            q0 (xdrx_midp (car q0) (cadr q0)) 
      ) 
      (command "scale" ss "" q0 df) 
      (if 
        (setq pt (xdrx_dragssmove "\n点取要移到的位置 <不移动>:" ss q0)) 
         (command ".move" ss "" q0 pt) 
      ) 
      (xdrx_end) 
    ) 
  ) 
  (princ) 
)[/FONT]

XDSoft · 发表于 2002-9-3 23:44:30

从XDRX_API函数用法的角度，修改了程序，你看看，体会下API处理选择集的方便性，这个用法是很多程序用到的。

[FONT=courier new]
;;详图比例设定
(defun c:xt1 (/ pt1 pt2 ss df q0 vh i lt e bl pt)
(if (and (setq pt1 (getpoint "\n窗口的第一点<退出>: "))
(setq pt2 (getcorner pt1 "\n窗口的第二点<退出>: "))
(setq ss (ssget "_w" pt1 pt2))
)
(progn
(xdrx_begin)
(if (setq vh (ssget "w" pt1 pt2 (list (cons 0 "DIMENSION"))))
(progn
(xdrx_setenttodb (ssname vh 0))
(setq bl (substr (xdrx_getentdxf 3) 5 3))
(setq df (getint (strcat "\n请输入详图比例 <1:" bl "> 1:")))
(if (null df)
(setq df (* 0.01 (atoi bl)))
(setq df (* 0.01 df))
)
(xdrx_setsstodb vh 0) ;;选择集入库
(while (setq e (xdrx_getentdata 0))
(command "dim1" "res" (xdrx_getentdxf 3))
(setvar "dimlfac" df)
(setvar "dimscale" 1)
(command "dim1" "update" e "")
)
)
(setq df (* 0.01 (getint "\n请输入详图比例 <退出> 1: ")))
)
(setq q0 (xdrx_entity_box ss)
q0 (xdrx_midp (car q0) (cadr q0))
)
(command "scale" ss "" q0 (/ 1 df))
(if
(setq pt (xdrx_dragssmove "\n点取要移到的位置 <不移动>:" ss q0))
(command ".move" ss "" q0 pt)
)
(xdrx_end)
)
)
(princ)
)
;;详图比例恢复
(defun c:xt2 (/ pt1 pt2 ss df q0 vh i lt e bl pt)
(if (and (setq pt1 (getpoint "\n窗口的第一点<退出>: "))
(setq pt2 (getcorner pt1 "\n窗口的第二点<退出>: "))
(setq ss (ssget "_w" pt1 pt2))
)
(progn
(xdrx_begin)
(if (setq vh (ssget "w" pt1 pt2 (list (cons 0 "DIMENSION"))))
(progn
(xdrx_setenttodb (ssname vh 0))
(setq bl (substr (xdrx_getentdxf 3) 5 3))
(setq df (getint (strcat "\n请输入详图比例 <1:" bl "> 1:")))
(if (null df)
(setq df (* 0.01 (atoi bl)))
(setq df (* 0.01 df))
)
(xdrx_setsstodb vh 0)
(while (setq e (xdrx_getentdata 0))
(command "dim1" "res" (xdrx_getentdxf 3))
(setvar "dimlfac" 1)
(setvar "dimscale" df)
(command "dim1" "update" e "")
)
)
(setq df (* 0.01 (getint "\n请输入详图比例 <退出> 1: ")))
)
(setq q0 (xdrx_entity_box ss)
q0 (xdrx_midp (car q0) (cadr q0))
)
(command "scale" ss "" q0 df)
(if
(setq pt (xdrx_dragssmove "\n点取要移到的位置 <不移动>:" ss q0))
(command ".move" ss "" q0 pt)
)
(xdrx_end)
)
)
(princ)
)[/FONT]

[FONT=courier new] 
;;详图比例设定 
(defun c:xt1 (/ pt1 pt2 ss df q0 vh i lt e bl pt) 
  (if (and (setq pt1 (getpoint "\n窗口的第一点<退出>: ")) 
           (setq pt2 (getcorner pt1 "\n窗口的第二点<退出>: ")) 
           (setq ss (ssget "_w" pt1 pt2)) 
      ) 
    (progn 
      (xdrx_begin) 
      (if (setq vh (ssget "w" pt1 pt2 (list (cons 0 "DIMENSION")))) 
        (progn 
          (xdrx_setenttodb (ssname vh 0)) 
          (setq bl (substr (xdrx_getentdxf 3) 5 3)) 
          (setq df (getint (strcat "\n请输入详图比例 <1:" bl "> 1:"))) 
          (if (null df) 
            (setq df (* 0.01 (atoi bl))) 
            (setq df (* 0.01 df)) 
          ) 
          (xdrx_setsstodb vh 0) ;;选择集入库 
          (while (setq e (xdrx_getentdata 0)) 
            (command "dim1" "res" (xdrx_getentdxf 3)) 
            (setvar "dimlfac" df) 
            (setvar "dimscale" 1) 
            (command "dim1" "update" e "") 
          ) 
        ) 
        (setq df (* 0.01 (getint "\n请输入详图比例 <退出> 1: "))) 
      ) 
      (setq q0 (xdrx_entity_box ss) 
            q0 (xdrx_midp (car q0) (cadr q0)) 
      ) 
      (command "scale" ss "" q0 (/ 1 df)) 
      (if 
        (setq pt (xdrx_dragssmove "\n点取要移到的位置 <不移动>:" ss q0)) 
         (command ".move" ss "" q0 pt) 
      ) 
      (xdrx_end) 
    ) 
  ) 
  (princ) 
) 
;;详图比例恢复 
(defun c:xt2 (/ pt1 pt2 ss df q0 vh i lt e bl pt) 
  (if (and (setq pt1 (getpoint "\n窗口的第一点<退出>: ")) 
           (setq pt2 (getcorner pt1 "\n窗口的第二点<退出>: ")) 
           (setq ss (ssget "_w" pt1 pt2)) 
      ) 
    (progn 
      (xdrx_begin) 
      (if (setq vh (ssget "w" pt1 pt2 (list (cons 0 "DIMENSION")))) 
        (progn 
          (xdrx_setenttodb (ssname vh 0)) 
          (setq bl (substr (xdrx_getentdxf 3) 5 3)) 
          (setq df (getint (strcat "\n请输入详图比例 <1:" bl ">  1:"))) 
          (if (null df) 
            (setq df (* 0.01 (atoi bl))) 
            (setq df (* 0.01 df)) 
          ) 
          (xdrx_setsstodb vh 0) 
          (while (setq e (xdrx_getentdata 0)) 
            (command "dim1" "res" (xdrx_getentdxf 3)) 
            (setvar "dimlfac" 1) 
            (setvar "dimscale" df) 
            (command "dim1" "update" e "") 
          ) 
        ) 
        (setq df (* 0.01 (getint "\n请输入详图比例 <退出> 1: "))) 
      ) 
      (setq q0 (xdrx_entity_box ss) 
            q0 (xdrx_midp (car q0) (cadr q0)) 
      ) 
      (command "scale" ss "" q0 df) 
      (if 
        (setq pt (xdrx_dragssmove "\n点取要移到的位置 <不移动>:" ss q0)) 
         (command ".move" ss "" q0 pt) 
      ) 
      (xdrx_end) 
    ) 
  ) 
  (princ) 
)[/FONT]

szkevin · 发表于 2002-9-3 23:51:39

我觉的不用这么复杂,不同比例图放在一起打印,最好的办法是做成块,再放大或缩小块,要修改时,再缩回去或放大再双击修改,习惯仍然是一样的,所以只用到一个命令,scale就行了.

XDSoft · 发表于 2002-9-3 23:58:05

借这个程序，说明矩阵变换的用法，下面代码的效率要远远高于使用SCALE命令，所有的ACAD对实体编辑的操作，都可以使用矩阵使用矩阵变换来完成。

程序中用SCALE命令缩放选择集，可以通过矩阵的变换完成

[FONT=courier new]
(setq mMat (xdrx_matrix_identity) ;;构造单位矩阵
mMat (xdrx_matrix_setscale mMat 比例 (trans 基点 1 0));;构造缩放矩阵
)
($xdlsp_pickset_transform 选择集 mMat)
[/FONT]

就完成缩放操作了。上面的矩阵换平移，旋转，镜像，对齐等等，单独或组合，构造完毕转换矩阵后，一次性变换选择集。

$xdlsp_pickset_transform函数定义如下（在XDLSP.LSP）中：

[FONT=courier new]
;|
选择集实体移动变换
|;
(defun $xdlsp_pickset_transform (ss mRMatrix / e)
(xdrx_setsstodb ss 0)
(while (setq e (xdrx_getentdata 0))
(xdrx_entity_transForm e mRMatrix)
)
(princ)
)
;|
选择集实体拷贝变换
|;
(defun $xdlsp_pickset_transformedCopy (ss mRMatrix / e)
(xdrx_setsstodb ss 9)
(while (setq e (xdrx_getentdata 9))
(xdrx_entity_transFormedCopy e mRMatrix)
)
(princ)
)[/FONT]

zdarc · 发表于 2002-9-3 23:58:39

作成块以后，简单的修改也要炸开，不方便

zdarc · 发表于 2002-9-4 00:11:40

块可以用在位编辑修改，但是也有放缩问题，而且在位编辑影响速度，过程中无法save。

szkevin · 发表于 2002-9-4 00:20:48

是的,放缩是个问题,而且标注值在编辑里所表示的值是原值X放缩系数,所以要有这个概念,如果修改量比较大,可以放缩回原来的比例,再修改.哪果觉的过程中不能save,可以找散,再组块.或拷贝一个到别的地方做备份,再修改个备份,2002组块再定义很简单.
不知大家平时画高层立面是什么画的?我一般不同层组成一块,以后改立面只改块,非常方便,而且快.

zdarc · 发表于 2002-9-4 00:26:07

对，重复的东西要用块（或参照），修改一个，其它就更新了。这是一个很好用的cad技巧！

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

[LISP程序]：详图比例设定、复原

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子