将lts图形改为lts 1000，且保持所有线型显示情况不变

tranney · 发表于 2014-4-27 10:39

谢谢z超版的给力帮助，哈哈，谢谢，已经达到我的要求了，谢谢哈
不过我好像把事情搞的复杂了一点
我稍微修改了一下，想可以修改已经插入的图形的线性比例，比如把已经插入原图为lts 50 插入到现在图形lts为1000的图中，然后在本图中选择修改，这种情况也比较多，代码如下
(defun c:tt (/ ltsold ltsnew ss en dxf celtsold celtsnew )
(setvar "CMDECHO" 0)
(setq ltsnew (getint "\n  输入需要修改后的lts，默认<1000>"));输入修改前的lts，默认为当前的lts,因为考虑很多图形是先插入后然后调整的
(if (null ltsnew)(setq ltsnew 1000))
(setq ltsold (getint "\n  输入需要修改前的lts，默认<当前的lts>"))
(if (null ltsold)(setq ltsold (getvar "ltscale") ));获取当前全局比例因子
(while (setq ss (ssget ":s"))
  (repeat (setq n (sslength ss))
(setq en (ssname ss (setq n (1- n))))
(setq dxf (entget en))
(if (assoc 48 dxf)
(setq celtsold (cdr(assoc 48 dxf)));获取当前线段的比例因子，因为现在要将图纸的全局比例因子改成1000，所以现在线型的celtscale要变成(1000/lsold )*celtsold
(setq celtsold 1)
)
(setq celtsnew (/ (* ltsold celtsold) ltsnew))
(if (assoc 6 dxf)
(if (/= (cdr(assoc 6 dxf)) "Continuous")
   (command "chprop" en "" "s" celtsnew "")
)
(if (/= (cdr(assoc 6 (tblsearch "LAYER" (cdr(assoc 8 dxf))))) "Continuous")
   (command "chprop" en "" "s" celtsnew "")
)
)
  )
)
(setvar  "ltscale" ltsnew)
(setvar "CMDECHO" 1)
(princ (strcat "\n---已经将所选对象全部比例因子即lts从" (rtos (* ltsold celtsold) 2) "改为"(rtos ltsnew)""))
(command "_.regen")
(princ)
)
我发现第2个数字输入的时候会出错
值必须为非零。
函数被取消

xyp1964 · 发表于 2014-4-27 11:37

本帖最后由 xyp1964 于 2014-4-27 11:38 编辑

;; 需要e派工具箱(XCAD)的支持：http://yunpan.cn/QXQKsW9gAPmpF 访问密码 2ffa
(defun c:tt ()
(setq int (Uint 7 "" "整数" int)
sc (/ (getvar 'ltscale) int)
i -1
)
(if (setq ss (ssget))
(while (setq s1 (ssname ss (setq i (1+ i))))
(if (setq ls (xyp-DXF 48 s1))
(xyp-SubUpd s1 48 (* ls sc))
(xyp-SubUpd s1 48 sc)
)
)
)
(setvar "ltscale" int)
(princ)
)

tranney · 发表于 2014-4-27 16:14

谢谢院长，不过我还是喜欢源代码，可以学习，方便使用

依然小小鸟 · 发表于 2018-10-4 10:09

不错的帖子支持一下

Sonnenblumen · 发表于 2020-3-18 17:02

tranney 发表于 2014-4-27 10:39
谢谢z超版的给力帮助，哈哈，谢谢，已经达到我的要求了，谢谢哈
不过我好像把事情搞的复杂了一点
我稍微 ...

感谢楼主，我加载了您的这个程序，提示输入的字符串有缺陷，恳请楼主帮助一下，我很需要您这个程序，非常感谢

tranney · 发表于 2020-3-18 18:25

Sonnenblumen 发表于 2020-3-18 17:02
感谢楼主，我加载了您的这个程序，提示输入的字符串有缺陷，恳请楼主帮助一下，我很需要您这个程序，非常 ...

zzxxqq版主解决的问题，你直接加载就好了

Sonnenblumen · 发表于 2020-3-18 18:54

tranney 发表于 2020-3-18 18:25
zzxxqq版主解决的问题，你直接加载就好了

感谢您的回复。我加载了，提示字符有缺陷,无法使用

Sonnenblumen · 发表于 2020-3-18 19:01

tranney 发表于 2020-3-18 18:25
zzxxqq版主解决的问题，你直接加载就好了

可以麻烦您帮我看一下吗？非常感谢

tranney · 发表于 2020-3-18 19:54

;改线型比例为1000，显示效果不变明经 2014.4.27
(defun c:Zcai_dt4(/ ltsold ss en dxf celtsold celtsnew)
  (print "\nQQ底图处理，改线型比例为1000，显示效果不变")
(setvar "CMDECHO" 0)
(cmdla0)
  (setq odfr (getvar "filletrad"))
  (setq ltsold (getvar "ltscale"));获取当前全局比例因子
  (while (setq ss (ssget ":s"))
(repeat (setq n (sslength ss))
(setq en (ssname ss (setq n (1- n))))
(setq dxf (entget en))
(if (assoc 48 dxf)
(setq celtsold (cdr(assoc 48 dxf)))
(setq celtsold 1)
)
(setq celtsnew (/ (* ltsold celtsold) 1000.0))
(if (assoc 6 dxf)
(if (/= (cdr(assoc 6 dxf)) "Continuous")
(command "chprop" en "" "s" celtsnew "")
)
(if (/= (cdr(assoc 6 (tblsearch "LAYER" (cdr(assoc 8 dxf))))) "Continuous")
(command "chprop" en "" "s" celtsnew "")
)
)
)
)
(setvar  "ltscale" 1000)
(setvar "CMDECHO" 1)
(princ (strcat "\n---已经将所选对象全部比例因子即lts从" (rtos (* ltsold celtsold) 2) "改为1000"))
(princ "\n")
(command "_.regen")
  (cmdla1)
(princ)
)

依然小小鸟 · 发表于 2020-3-19 08:51

tranney 发表于 2020-3-18 19:54
;改线型比例为1000，显示效果不变明经 2014.4.27
(defun c:Zcai_dt4(/ ltsold ss en dxf celtsold celtsn ...

请问下我遇到跟你一样的问题只不过我习惯lts设置为1 而别人的lts可能是1000 可能是50 可能是100 所以我就想能不能在代码中增加选项（比如先弹出提示我的图线性比例是多少我输入1 像你就可能输入1000 ）然后再进行将其他人的图插入到我的图这种操作

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

[已解答] 将lts图形改为lts 1000，且保持所有线型显示情况不变

点评

本帖子中包含更多资源