调整线形比例小程序

liu22737

调整线形小程序

baizhan

怎么没东西的

liu22737

 

(defun c:ssd(/ a1 lt sc pt ss ent lis_0 list_ent H&D lsx_oldvars)
 (defun lsx_newerr(msg)(setq *error* lsx_olderr)(command)(command "undo" "end")(mapcar 'setvar '("cmdecho" "osmode")lsx_oldvars)(princ));endlsx_newerr
 (setq lsx_olderr *error* *error* lsx_newerr lsx_oldvars(mapcar 'getvar '("cmdecho" "osmode")))
 (setvar "osmode" 0)(setvar "cmdecho" 0)(command "undo" "group")
(setq list_ent '() ss(ssadd) ent t H&D nil)
(prompt "\n修改块内线型比例")
(command"trim")
(while ent
  (command(setq ent(nentsel)pt(cadr ent)))(command pt)
  (setq list_ent(append(list(car ent))list_ent))
  (if(and(>(length ent)2)(not(ssmemb(last(last ent))ss)))(setq ss(ssadd(last(last ent))ss)))
 );while
(setq list_ent(vl-remove nil list_ent) lis_0 '() ent(car list_ent))
(foreach ent list_ent
  (if(and(vl-position(cdr(assoc 0(entget ent)))'("LWPOLYLINE" "CIRCLE" "MLINE" "ARC" "SPLINE" "RAY" "ELLIPSE" "LINE" "XLINE"))
     (not(vl-position ent lis_0)))(setq lis_0(append(list ent)lis_0)));if
 );foreach
(while lis_0
   (cond((or(= H&D "H")(= H&D "h"))  (setq a1(getstring"\nHalf Scale<H>:"))(if(or(= a1 "D")(= a1 "d"))(setq sc 2.0 H&D a1)))
 ((or(= H&D "D")(= H&D "d"))(setq a1(getstring"\nDouble Scale<D>:"))(if(or(= a1 "H")(= a1 "h"))(setq sc 0.5 H&D a1)))
  (t(setq H&D(getstring"\n*<H>alf Scale* & *<D>ouble Scale* <H>:"))
   (if(= "" H&D)(setq H&D "H"))(if(or(= H&D "H")(= H&D "h"))(setq sc 0.5)(setq sc 2.0))));cond
   (setq ent(car lis_0))
   (foreach ent lis_0(setq a1(entget ent))
     (if(setq lt(cdr(assoc 48 a1)))(entmod(subst(cons 48(* lt sc))(assoc 48 a1)a1))(entmod(append a1(list(cons 48 sc))))));foreach
   (command"move"ss""'(0 0)'(0 0)))while;
(mapcar 'setvar '("cmdecho" "osmode")lsx_oldvars)
(setq *error* lsx_olderr)
(command "undo" "end")
(princ)
);end

liu22737

 加强版

取消了自动安装

众山小

输入时命令名称太长了，应该简化一点

www2002

收下试试看！！

liu22737

众山小发表于2008-8-27 8:37:00输入时命令名称太长了，应该简化一点

starlet2003

希望有源码可以研究一下

display18

顶你楼主，好程序

dkj0322

谢谢分享！很不错