社区 › AutoCAD工具插件 › Cad图块中线型比例修改

fzlinrong 发表于 2023-4-18 17:15:04

屏录软件下载地址在哪？

ferious 发表于 2023-4-18 17:26:24

软件名就是这个，之前下载的清理了。百度有很多资源的。:lol

ferious 发表于 2023-4-18 19:52:45

liuhe 发表于 2023-4-18 13:09
关于 entmod 函数所作的修改有一些限制：

不能改变一个图元的类型和句柄。如果一定要这样做，只能先调 ...

你好，首先非常遗憾，还是不灵，虽然没有报错！

提示输入线型比例，50.再选择块，然后炸开块，原来块内直线比例还是1？？？
能帮忙试下？
文件样板和动态效果见附件。
BESTREGARDS!

huisguiji 发表于 2023-4-19 00:10:18

谢谢分享，，，，，，，，，，，

liuhe 发表于 2023-4-19 08:57:55

ferious 发表于 2023-4-18 19:52
你好，首先非常遗憾，还是不灵，虽然没有报错！

提示输入线型比例，50.再选择块，然后炸开块，原来块 ...

代码没有问题，问题是你没有看懂。我是根据你的代码增加了对(="DASHED"(vla-GEt-linetype obj ))，很显然你没有把它删掉，才导致没有修改

ferious 发表于 2023-4-19 20:51:14

不谢，水平有限，暂时还没搞定cad块内线型比例修改。:lol

ferious 发表于 2023-4-20 11:22:15

kucha007 发表于 2023-4-17 21:16
要学会自己搜索啊= =http://bbs.mjtd.com/thread-186469-1-1.html

你好，能不能帮忙调试好，成品源码发出来？:lol

ferious 发表于 2023-4-20 14:01:22

感谢河流之王支持，帮忙调试好，无私奉献源码如下。
可修改单个线型改为设置输入的线型比例:lol
另外大家有需求的，可以找河流大神定制。专业且态度好

(defun c:lts (/ lts:processed idx scl sel LINENAME)
(initget 6)
(if (not scl2)
    (setq scl2 20)
)
(if (NOT (setq scl
                  (getreal (STRCAT "\n 请输入线性型比例<" (rtos scl2 2 0) ">")
                  )
           )
      )
    (SETQ SCL SCL2)
    (SETQ SCL2 SCL)
)
(PRINC "\n 选择源线型和修改图形")
(if (setq sel (ssget))
    (PROGN
      (repeat (setq idx (sslength sel))
        (SETQ E (ssname sel (setq idx (1- idx))))
        (IF (/= "INSERT" (CDR (ASSOC 0 (ENTGET E))))
          (PROGN
          (SETQ LINENAME
                   (vl-catch-all-apply
                     'vla-GEt-linetype
                     (LIST (vlax-ename->vla-object E))
                   )
          )
          (IF        (= LINENAME "ByLayer")
              (SETQ LINENAME
                     (CDR (ASSOC
                          6
                          (tblsearch "LAYER"
                                     (CDR (ASSOC 8 (ENTGET E)))
                          )
                          )
                     )
              )
          )
          )
        )
      )
      (repeat (setq idx (sslength sel))
        (lts:obj
          (vlax-ename->vla-object (ssname sel (setq idx (1- idx))))
          scl
          LINENAME
        )
      )
    )
)
(vla-regen lts:acdoc acallviewports)
(princ)
)
(defun lts:blk (obj scl / bln)
(if (not (member (setq bln (vla-get-name obj)) lts:processed))
    (progn
      (vlax-map-collection
        (vla-item lts:acblk bln)
        '(lambda (obj) (lts:obj obj scl LINENAME))
      )
      (setq lts:processed (cons bln lts:processed))
    )
)
)
(defun lts:obj (obj scl LINENAME / LINENAME1)
(IF (= (vla-GEt-linetype obj) "ByLayer")
    (SETQ LINENAME1
           (CDR
             (ASSOC
             6
             (tblsearch "LAYER"
                          (CDR (ASSOC 8 (ENTGET (vlax-vla-object->ename obj))))
             )
             )
           )
    )
    (SETQ LINENAME1 (vla-GEt-linetype obj))
)
(if (and (vlax-write-enabled-p obj)
           (vlax-property-available-p obj 'linetypescale t)
           (= LINENAME LINENAME1)
      )

    (vla-put-linetypescale obj scl)
)
(if (= "AcDbBlockReference" (vla-get-objectname obj))
    (lts:blk obj scl)
)
)
(setq lts:acdoc        (vla-get-activedocument (vlax-get-acad-object))
      lts:acblk        (vla-get-blocks lts:acdoc)
)
(vl-load-com)
(princ)

lxl217114 发表于 2023-4-20 17:40:02

谢谢分享，点赞收藏。

查看完整版本: Cad图块中线型比例修改