shang_123 发表于 2011-10-6 16:18:58

谁能帮我改改这个LISP 谢谢啦

;x,y方向不同比例缩放
; ***XSCALE    6/22/2005***
;
;Copyleft Gu Wenwei
;
; ***************************************
; ****Author:Apooollo            ****
; ****                               ****
; ****Wuxi Jiangsu China         ****
; ***************************************
;
;
; This program takes selected objects, defines an anonymous block,
; then inserts the block at the original location, Scale by X,Y

(defun C:ss(/ bp ss xscal yscal entL)
(defun errexit (s)
    (princ "\nError:")
    (princ s)
    (restore)
)
(defun restore ()
    (setvar "CMDECHO" (car oldvar))
    (setq *error* olderr)
    (princ)
)

(defun MAKEUNBLOCK (ss ip / tmp errexit mbx BLAYER)
(setq T (not nil))
(setq olderr*error*
      *error* errexit
)
(setq oldvar
    (list
      (getvar "CMDECHO")
    )
)
(setvar "CMDECHO" 0)
(terpri)
(if BLAYER
    (command "._LAYER"
      (if (tblsearch "LAYER" BLAYER) "_S" "_M")
      BLAYER
      ""
    )
)
(if (and ip ss)
    (progn
      (entmake (list
      (cons '0 "BLOCK")
      (cons '2 "*U")
      (cons '70 1)
      (cons '10 ip)
      ))
      (setq cnt (sslength ss))
      (while (>= (setq cnt (1- cnt)) 0)
      (setq tmp (ssname ss cnt))
      (entmake (setq el (entget tmp)))
      (if (> (cdr (assoc 66 el)) 0)
          (while
            (/= "SEQEND"
            (cdr
                (assoc 0
                  (entmake (setq el (entget (entnext (cdr (assoc -1 el))))))
                )
            )
            )
          )
      )
      (entdel tmp)
      )
      (setq tmp (entmake (list (cons '0 "ENDBLK"))))
      (entmake (list
      (cons '0 "INSERT")
      (cons '2 tmp)
      (cons '10 ip)
      ))
    )
)
(restore)
)
(setq ss (ssget))    ;;; 选择缩放实体
(if ss
    (progn
      (setvar "cmdecho" 0)
      (setq bp (getpoint "缩放基准点 (<0,0,0>): "))
      (if (not bp) (setq bp (list 0 0 0)))
      (setq xscal (getreal "X向比例因子 <1>: "))
      (if (not xscal) (setq xscal 1))
      (setq yscal (getreal "Y向比例因子 <1>: "))
      (if (not yscal) (setq yscal 1))
      (MAKEUNBLOCK ss bp)
      (setq entL (entget (entLast))
   entL (subst (cons 41 xscal) (assoc 41 entL) entL)
   entL (subst (cons 42 yscal) (assoc 42 entL) entL)
      )
      (entmod entL)
      (command "_explode" "l" "")
    )
)
(princ "X,Y不同比例缩放, 命令:XSCALE")
)

这是个双向不等比例缩放命令, 程序可以用, 就是谁能帮改成
1.缩放比例因子的时候可参照《就像CAD自带的缩放参照命令一样》
2.这个命令缩放完成后 它会分解成单个对象《假如 是个巨型缩放的话,缩放完后 它会变成4条直线》 愿改成 缩放完成后 巨型还是巨型,不分解。

shang_123 发表于 2011-10-7 19:16:28

来人 帮帮忙啦!!!

cnks 发表于 2011-10-7 23:47:58

他的原理就是先做成块然后设置比例再炸开,所以把这句删了就行了:
(command "_explode" "l" "")

shang_123 发表于 2011-10-8 01:27:30

本帖最后由 shang_123 于 2011-10-8 01:28 编辑

cnks 发表于 2011-10-7 23:47 http://bbs.mjtd.com/static/image/common/back.gif
他的原理就是先做成块然后设置比例再炸开,所以把这句删了就行了:
(command "_explode" "l" "")

哦!! 我删了以后它就成为一个块了 要是分解后 它还是单个对象!  要是像CAD里面的缩放 我改怎么改 既能参照 缩放完后 还能不是个块!!望指教!!

shang_123 发表于 2011-10-11 20:36:20

来高手帮帮忙啊!!!

chpmould 发表于 2011-10-11 22:03:16

如果不想做成块来处理,那就换一种方法吧,直接采用缩放命令来处理,就是麻烦一点,需要自己计算缩放比例

shang_123 发表于 2011-10-12 09:05:59

chpmould 发表于 2011-10-11 22:03 static/image/common/back.gif
如果不想做成块来处理,那就换一种方法吧,直接采用缩放命令来处理,就是麻烦一点,需要自己计算缩放比例

能帮 给写个LISP吗?

wqewq 发表于 2011-10-13 21:44:04

;;;调整对象XY比例
;;;程序设计:赖云龙;;;
;;;---------------;;;
(defun C:SCXY (/ holdosmode AA PT X Y PT1 PT2 L1 L2)
(command "_.undo" "_be")
(setq holdosmode (getvar "osmode"))
(setvar "osmode" 39)
(defun LL ()
    (setq PT1 (getpoint "\n参考长度基准点: "))
    (setq PT2 (getpoint PT1 "\n第二点: "))
    (setq L1 (distance PT1 PT2))
    (setq PT1 (getpoint "\n新的长度基准点: "))
    (setq PT2 (getpoint PT1 "\n第二点: "))
    (setq L2 (distance PT1 PT2))
)
(while (= AA NIL)
    (setq AA (ssget))
)
(setq PT (getpoint "\n基准点 : "))
(setq X (getstring "\n/参考(R) <1>: "))
(cond
    ((= X "")
   (setq X 1)
    )
    ((or (= X "R") (= X "r"))
   (LL)
   (setq X (/ L1 L2))
    )
    (t
   (setq X (atof X))
    )
)
(setq        Y (getstring (strcat "\n/参考(R) <" (rtos X) ">: ")
          )
)
(cond
    ((= Y "")
   (setq Y 1)
    )
    ((or (= Y "R") (= Y "r"))
   (LL)
   (setq Y (/ L1 L2))
    )
)
(setq A (rtos (* (getvar "CDATE") 1E8)))
(command "_.BLOCK" A PT AA "")
(command "_.INSERT" A PT X Y "")
(command "_.EXPLODE" "L")
(prompt "\n")
(command "_.purge" "b" A "n")
(setvar "osmode" holdosmode)
(command "_.undo" "_end")
(princ)
)

shang_123 发表于 2011-10-14 15:09:47

wqewq 发表于 2011-10-13 21:44 static/image/common/back.gif
;;;调整对象XY比例
;;;程序设计:赖云龙;;;
;;;---------------;;;


这个不行 它放缩后对象会被分解
页: [1]
查看完整版本: 谁能帮我改改这个LISP 谢谢啦