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

tranney · 发表于 2014-4-25 01:53:40

本帖最后由 tranney 于 2014-4-25 16:52 编辑

我拼凑起来的程序，呵呵不管用啊麻烦各位大哥帮我看看谢谢了
我需要的不是改全局变量LTS，而是把所选择的所有虚线的单个线型比例一下子缩放N倍的工具,经常遇到这样的问题，拿到别人的图纸，他的全局线型比例和我的不同，但是里面的单个线型的线型比例有很多种，
我习惯LTS设置为1000，但有的图纸是10，或100，如果我强制把别人的图纸改为1000，则里面所有的虚线都变了，所以我需要一个工具，可以把lts改变为我需要的值，并且里面的线型显示不变
比如，他的lts是100，1线的线型比例是20，2线的线型比例是50，则执行下面命令后需要1线的线型比例修改成是2，2线的线型比例是5，这样的画显示效果是完全与原图相同的。我拼凑起来不成功，请大伙帮忙写一个，谢谢了，

(defun c:tt (/ ltsold ss en dxf celtsold celtsnew)
  (setvar "CMDECHO" 0)
  (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 (= (cdr (assoc 6 dxf)))
      (progn
      (setq celtsold (getvar "celtscale"))
;获取当前线段的比例因子，因为现在要将图纸的全局比例因子改成1000，
;所以现在线型的celtscale变成(1000/lsold )*celtsold
      (setq celtsnew (* (/ ltsold 1000.0) celtsold))
      (command "chprop" en "" "s" celtsnew "")
      )
   )
)
  )
  (setvar "ltscale" 1000)
  (setvar "CMDECHO" 1)
  (princ (strcat "\n---已经将所选对象全部比例因子即lts从"(rtos ltsold)"改为1000")
  )
  (princ)
)

ZZXXQQ · 发表于 2014-4-25 01:53:41

本帖最后由 ZZXXQQ 于 2014-4-27 07:33 编辑

;改线型比例明经 2014.4.27
(defun c:tt ();/ ltsold ss en dxf celtsold celtsnew)
(setvar "CMDECHO" 0)
(setq ltsold (getvar "ltscale"));获取当前全局比例因子
; (setq ss (ssget "X" '((0 . "ARC,CIRCLE,ELLIPSE,LINE,*POLYLINE"))));选择所有的线
(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) 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)
)

;改线型比例 明经 2014.4.27 
(defun c:tt ();/ ltsold ss en dxf celtsold celtsnew) 
 (setvar "CMDECHO" 0) 
 (setq ltsold (getvar "ltscale"));获取当前全局比例因子 
; (setq ss (ssget "X" '((0 . "ARC,CIRCLE,ELLIPSE,LINE,*POLYLINE"))));选择所有的线 
 (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) 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) 
)

Andyhon · 发表于 2014-4-25 07:44:20

那一句过不去啊
您没加注,怎知叙述句不合所求

tranney · 发表于 2014-4-25 11:19:18

ZZXXQQ 发表于 2014-4-25 08:12

超级版主好，运行代码选择物体后出现错误提示代码
; 错误: 参数类型错误: numberp: nil

ZZXXQQ · 发表于 2014-4-25 22:48:27

板凳改了。再试试看

tranney · 发表于 2014-4-26 03:08:14

zzxxqq超版你好，刚试了一下出现错误
参数类型错误: numberp: "Continuous"

ZZXXQQ · 发表于 2014-4-26 08:16:18

tranney 发表于 2014-4-26 03:08
zzxxqq超版你好，刚试了一下出现错误
参数类型错误: numberp: "Continuous"

程序经过调试，未发现问题。

tranney · 发表于 2014-4-26 10:39:25

经过测试，真的发现问题了，
首先对于任何设置了线性的都会弹出错误，线型不是bylayer而是指定线性的都会弹出
错误:参数类型错误: numberp: "DASH"等等
第2，并没有每个图元获取他的线型比例计算后重新赋值给图元，每个都一样了
详细见运行后要求和测试图

ZZXXQQ · 发表于 2014-4-26 20:50:02

程序又改了，再试试。

tranney · 发表于 2014-4-26 21:53:32

本帖最后由 tranney 于 2014-4-26 22:06 编辑

z超版你好，本代码基本上完成了要求，
测试后效果如下

但是版主他这里对已图层管理器内设置为非continuous的线型未能做出修改，图见第3根线，
请求z超版劳神费心修改再修改完美一下

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

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

最佳答案

相关帖子

评分

本帖子中包含更多资源

本帖子中包含更多资源

点评