[LISP]简单的图块批量修改(旋转,比例);新手,写的有点乱

long9841

新手,写的有点乱

本程序可以批量修改图块比例,和旋转角度,都时相对于图块本身的角度和比例哦

;;;仅用于平面图形;简单的旋转,改变比例,图块
;;;只能 用于块,
;;;
(defun c:rbk (/     a1   a0 a1e   a1n   a1_obj szj   str
       jd    ssa1  sn n     pro   a1on  ne na1e  newa1
       cmd   newa  a1x a1y   newaxy   str0 str1  roscal
      )

  (setq a1     (entsel "请选择要旋转的块：")
 a0     (car a1)
 a1e    (entget a0)
 a1n    (assoc 2 a1e)
 a1_obj (assoc 0 a1e)
 na1e   (assoc 50 a1e)
        ax     (assoc 41 a1e)
 cmd    (getvar "cmdecho")
 szj    (ssadd a0)
  )
  (setq ssa1 (ssget "x" (list a1n)))
  (setq sn (sslength ssa1))
  (sssetfirst ssa1 szj)
  (princ (strcat "\n您选择的块名为："
   (cdr a1n)
   "; 共有 "
   (itoa sn)
   "个。 "
                 "旋转角度为: "
   (angtos (cdr na1e))
   "   比例因子为: "
   (rtos  (cdr ax))
   ))
  (setq str1 (getstring "\n改变块 (角度 J) \\ (块比例 B)  <角度>:"))
  (if (= (STRCASE str1) "B")
    (progn
      (Setq str0 (getreal "\n请输入要缩放块的比例: ")
     a1x  (cons 41 str0)
     a1y  (cons 42 str0)

      )
      (setq roscal (strcat "\n比例因子为：" (rtos str0)))
    )

    (progn
      (setq
 str (getstring "\n请输入要旋转块的角度(格式： d  ' \"): ")
 jd  (angtof str)
 pro (cons 50 jd)
      )
      (setq roscal (strcat "\n旋转角度为：" str))
    )
  )

;;;  (setq pro (cons 50 jd))
  (setq n 0)
  (if (= (STRCASE str1) "B")
    (progn
      (repeat sn
 (setq a1on (ssname ssa1 n)
       ne   (entget a1on)
       ax   (assoc 41 ne)
       ay   (assoc 42 ne)
 )
 (setq newa (subst a1x ax ne))
 (setq newaxy (subst a1y ay newa))
 (setq n (1+ n))
 (entmod newaxy)

      )
    )
    (progn
      (repeat sn
 (setq a1on (ssname ssa1 n)
       ne   (entget a1on)
       na1e (assoc 50 ne)
 )
 (setq newa1 (subst pro na1e ne))
 (setq n (1+ n))
 (entmod newa1)
      )
    )
  )
  (sssetfirst nil nil)
  (setvar "cmdecho" cmd)
  (alert (strcat "您选择的块名为："
   (cdr a1n)
   "; \n共有 "
   (itoa sn)
   " 个 \n被改变为  "
                 roscal
  )
  )
  (princ)

)
     ;定义子函数
     ;(defun sa1()
     ; (setq a1 (entsel "选择要旋转的块")
;;;  (princ "\n 您选择的块,共有 ")
;;;  (princ sn)
;;;  (princ " 同名块。旋转角度为")
;;;  (princ str)
     ; a1e (entget (car a1))
     ; a1n (assoc 2 a1e)
     ; a1_obj (assoc 0 a1e)
     ;  )
     ; )

liexpress

写的不错，支持

jkop

个人觉得很实用！收藏！感谢分享。