谁能帮我改改这个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条直线》 愿改成 缩放完成后 巨型还是巨型,不分解。
来人 帮帮忙啦!!! 他的原理就是先做成块然后设置比例再炸开,所以把这句删了就行了:
(command "_explode" "l" "")
本帖最后由 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里面的缩放 我改怎么改 既能参照 缩放完后 还能不是个块!!望指教!! 来高手帮帮忙啊!!! 如果不想做成块来处理,那就换一种方法吧,直接采用缩放命令来处理,就是麻烦一点,需要自己计算缩放比例 chpmould 发表于 2011-10-11 22:03 static/image/common/back.gif
如果不想做成块来处理,那就换一种方法吧,直接采用缩放命令来处理,就是麻烦一点,需要自己计算缩放比例
能帮 给写个LISP吗? ;;;调整对象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)
)
wqewq 发表于 2011-10-13 21:44 static/image/common/back.gif
;;;调整对象XY比例
;;;程序设计:赖云龙;;;
;;;---------------;;;
这个不行 它放缩后对象会被分解
页:
[1]