改线型比例的lsp程序(已解决)

669423907

回复 zhongys 的帖子

我用appload加载也没有反应吖？

zhongys

;;;修改了一下
(defun c:tt(/ ss val)
(while (= ss nil) (setq ss (ssget)))
(initget "1 2 4")
(setq val (getreal "\n 输入线型比例<1>:"))
(if (or (= val nil)(= val "")) (setq val 1))
(COMMAND "CHPROP" ss "" "S" val "")
(princ)
)

tm20038175

还是不能提示原始比例呀，如果不是1的话。

zhongys

如果你线型都是统一比例的话，要提示比例倒是可以，如果选择的线型有多个比例的话，就不好用了，你要用那一个比例就不好区分了，如下：
选择对象:

                  圆         图层: moldbase
                            空间: 模型空间
                   颜色: 8    线型: HIDDEN
线型比例 =      0.81                   句柄 = 20d
                圆心 点， X=   321.36  Y=   166.55  Z=     0.00
                半径      9.00
     周长     56.55
              面积    254.47

                  直线        图层: moldbase
                            空间: 模型空间
                   颜色: 8    线型: HIDDEN
线型比例 =      2.03                   句柄 = 1bd
                 自 点， X=   339.36  Y=   404.55  Z=     0.00
                 到 点， X=   339.36  Y=   108.55  Z=     0.00
          长度 =   296.00，在 XY 平面中的角度 = 270.00
                  增量 X =     0.00，增量 Y =   -296.00，增量 Z =     0.00

669423907

回复 zhongys 的帖子

谢谢你的热心帮助。
一般用于单个对象的修改。
你的程序好像还不能连续修改吖。

zhongys

;;;修改线型比例,单选
(defun c:clt(/ AcadObject AcadDocument mSpace obj currltscale val newltscale)
  (vl-load-com)
(defun *error* (msg)(princ))
(setq AcadObject(vlax-get-acad-object)
        AcadDocument(vla-get-ActiveDocument Acadobject)
        mSpace(vla-get-ModelSpace Acaddocument)
  )

  (initget "Z J")
  (setq val (getkword "\n 线型比例 [放大2倍(Z),缩小0.5倍(J)]<Z>:"))
  (IF (or(= val nil)(= val "")) (setq val "Z"))

  (while
  (setq obj (vlax-ename->vla-object (car (entsel"\n请选择要更改线型比例的图元: "))))
  (setq currLTScale(vla-get-LinetypeScale Obj))
  (princ (STRCAT "\n 当前线的线型比例是:" (RTOS currLTScale)))
  (setq val (strcase val))
    (COND
        ((= val "Z")(vla-put-LinetypeScale Obj (* currLTScale 2)))
        ((= val "J")(vla-put-LinetypeScale Obj (* currLTScale 0.5)))
    )
  (vla-Update Obj)
  (setq newLTScale(vla-get-LinetypeScale Obj))
)
  (princ (STRCAT "\n 线新的线型比例是:" (RTOS newLTScale)))
  (princ)
  )

应15楼的要求修改了个单选程式，对话框可自行加，在本论坛搜索了一下，此种例子已有，献丑了。

slzlfs

选中线 ctrl+1  直接改就行了

tm20038175

回复 zhongys 的帖子

不错，基本功能都实现了，太强了。如果兴趣可以研究下整张图纸线型比例缩放一倍问题，包夸块，呵呵…

669423907

回复 zhongys 的帖子

我认为还可以改得更好一些：
1，设置两个快捷键，一个放大一个缩小（用左右键更好）
2，可以输入缩放倍数（不输入是默认1.1,  0.91）

第一个我用最笨的方法实现了：
把程序复制，把复制的(IF (or(= val nil)(= val "")) (setq val "Z"))   中 "Z"改为"j"


不知哪位朋友方便帮忙改得更好一些（要是能框选，哪就完美了）！！！

谢谢啦！

liu22737

回复 669423907 的帖子

试试这个合不合要求
命令sd