如何用lsp删除绑定外部参照后 文字样式、标注样式、图块名、线型 产生的$0$前缀

nfz

MUSIC-DIE 发表于 2021-7-24 10:59
在绑定前设置   变量   bindtype   
(setvar "BINDTYPE"         0)      带前缀绑定
(setvar "BINDTYPE"         1)    ...

这方法好，很多图纸已经绑定了，处理别人的图纸还是不行

aihuyujian

tigcat 发表于 2021-7-16 13:01
可否贴源码？

我又精简了一下 不想对天正实体还有CAD本身对象区分了  但是效率肯定更低了 每个对象都得把属性全部测试一遍
clayxcmc 为带$0$前缀的图层
claythmc 为nil默认为去掉$0$前缀之后的图层
;; 命令: 修改图层    dx对象 0对象内部图层 1 dx对象本身图层 2内部图层及对象本身图层  需要去掉的图层  用来替换的图层
(defun changedxlayer (claydx claygetk clayxcmc claythmc / cob claymc l_clayxcmc l_claythmc)
      (if (= (type claydx) 'ename)(setq cob (vlax-ename->vla-object claydx))(setq cob claydx))
      (setq claymc (cdr (assoc 0 (entget (vlax-vla-object->ename cob)))))
      (setq l_clayxcmc clayxcmc l_claythmc claythmc)
      (if l_clayxcmc (if (null l_claythmc)(setq l_claythmc (car (reverse (GXL-STRPARSE l_clayxcmc "$0$"))))))
      (if (null (tblsearch "LAYER" l_claythmc))(entmake (list'(0 . "LAYER")'(100 . "AcDbSymbolTableRecord")'(100 . "AcDbLayerTableRecord")'(70 . 0)(cons 2 l_claythmc))))
     (if (or (= claygetk "0")(= claygetk "2")) (if (= claymc "INSERT")
                                                   (if (vla-Get-HasAttributes cob)(mapcar '(lambda(x) (if (= (vlax-get-property x 'Layer) l_clayxcmc)(vlax-put-property x 'Layer l_claythmc))) (xz-att-g (vlax-vla-object->ename cob) "attdx")))
                                                   (mapcar '(lambda(x) (if (vlax-property-available-p cob x) (if (= (vlax-get-property cob x) l_clayxcmc)(vlax-put-property cob x l_claythmc))))
                                                            (list 'HatchLayer 'SurfLayer 'LeftLayer 'RightLayer 'RowLayer 'GlassLayer 'ColLayer 'LayerHatch 'FrameLayer 'TextLayer 'Slablayer 'InsulateLayer 'GroundLayer 'BeamLayer 'StepLayer 'ArrowLayer 'RailLayer 'HandRailLayer))))
     (if (or (= claygetk "1")(= claygetk "2")) (if (= (vlax-get-property cob 'Layer) l_clayxcmc)(vlax-put-property cob 'Layer l_claythmc)))
     )

tigcat

aihuyujian 发表于 2021-8-9 11:32
我又精简了一下 不想对天正实体还有CAD本身对象区分了  但是效率肯定更低了 每个对象都得把属性全部测试 ...

嗯,用到了Gu版的函数,wudechao其实有写一个程序,是针对图层的,另外还有一个大侠也写了一个,论坛应该有两个去参照前缀的代码,当然,都是只针对图层,这个算是第3个,得加载G版的函数库.

aihuyujian

tigcat 发表于 2021-8-9 22:36
嗯,用到了Gu版的函数,wudechao其实有写一个程序,是针对图层的,另外还有一个大侠也写了一个,论坛应该有两 ...

我已经又重新修改优化一遍  已经测试过了没毛病  用了G版的字符串分割 这个好一点就是以后发现还有天正的啥图层没改直接加在mapcar 后面(list 'HatchLayer 'SurfLayer 'LeftLayer ...）这个表里就好了  

尘缘一生

顶起来这个问题，没有代码还。。。。

vladimirputin

非常不错代码，谢谢楼主分享啊

w986424017

aihuyujian 发表于 2021-8-10 08:54
我已经又重新修改优化一遍  已经测试过了没毛病  用了G版的字符串分割 这个好一点就是以后发现还有天正的 ...

老哥用不了，是不是得有外部api 同天正用户

w986424017

nfz 发表于 2021-7-19 13:42
用不了，提示
出错: 参数类型错误: VLA-OBJECT nil

处理不了天正

nyistjz

你试试这个，我平时用的是这个

;======================================================================================
;AutoCAD合并图层命令【laymrg】
;如果图纸用参照方法导入图元，图层名称会有【$】这样的内容添加，会造成图层很多的情况，
;如果把【$】后面名称相同的图层合并，手动的话就比较麻烦。
;要合并相同后缀的图层，可以使用程序来解决.
;一键所有图层去除【#】及【$】前缀的命名
(defun c:unxreflapre(/ ocl ss5)
        ;(princ "-->消除外部参照图层名前缀")
        (setvar "cmdecho" 0)
        (vla-StartUndoMark *doc*)
        (princ "\n消除绑定外部参照，在图层名称中所形成的【$】这样内容添加")
        (setvar "blipmode" 0)
        (if (null vlax-dump-object)(vl-load-com))
        (setq ocl (getvar "clayer"))
        (setq ss5 (x1812031));检查图层是否有冻结，锁定或者关闭
        (if (car ss5) (x1812032 ss5));还原图层
        (setvar "clayer" ocl)
        (if (s1811301) ;修改图层名称
                (progn(terpri)(princ ">>>已消除图层前缀并完成合并"))
                (princ "\n提示：没有外部参照绑定后的图层前缀")
        )
        (vla-EndUndoMark *doc*)
        (setvar "cmdecho" 1)
        (princ)
)

;取得所有图层名称
(defun w1810232 (doc / doc lay obj ss tc)
        (setq lay (vla-get-layers doc) ss '())
        (vlax-for obj lay
                (setq tc (vla-get-name obj));取得图层名称
                (setq ss (cons (list tc obj) ss))
        )
        ss
)
;修改图层名称
(defun s1811301 (/ doc n obj s2 ss2 ss3 tc1 tc2 x)
        (setq
                doc (vla-get-activedocument (vlax-get-acad-object));取得当前所有对象集合
                ss2 (w1810232 doc);图层集合
                ss3 (mapcar 'strcase (mapcar 'car ss2));图层名称集合
                ;tc1 (getvar "clayer");取得当前图层名称
        )
        ;(if (or (vl-string-search "\#" tc1 0)(vl-string-search "$" tc1 0))(setvar "clayer" "0"));如果当前图层需要修改，就转换图层为"0"
        (setvar "clayer" "0")
        (while (setq s2 (car ss2));处理图层
                (setq ss2 (cdr ss2) tc1 (car s2) tc2 tc1 obj (cadr s2))
                (while (vl-string-search "\#" tc2 0)(setq tc2 (vl-string-subst "" "\#" tc2)));处理有#的图层名称
                (while (setq n (vl-string-search "$" tc2 0))(setq tc2 (substr tc2 (+ 2 n))));处理有$的图层名称
                ;(while (setq n (vl-string-search "A-" tc2 0))(setq tc2 (substr tc2 (+ 3 n))));处理有A-的名称
                (if (= tc2 "")(setq tc2 "0"));如果是空就修改图层为"0"
                (if (/= tc2 tc1);如果名称发生变化
                        (progn
                                (if (member (strcase tc2) ss3);2;如果已经有这个图层名称
                                        (progn
                                                (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-delete (list obj)));删除这个图层
                                                        (progn
                                                                (vl-catch-all-apply 'vl-cmdf (list "laymrg" "N" tc1 "" "N" tc2 "Y"))
                                                                ;(Command "laymrg" "N" tc1 "" "N" tc2 "Y");如果图层不能删除就合并
                                                        )
                                                )
                                        )
                                        (progn
                                                (if ;如果没有相同命名的图层就改变图层名称
                                                        (null (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-name (list obj tc2))))
                                                        (setq ss3 (cons (strcase tc2) ss3))
                                                )
                                        )
                                )
                                (setq x t)
                        )
                )
        )
        x
)
;还原图层状态
(defun x1812032 (ss / ss x y)
        (setq ss (vl-remove-if '(lambda (x)(vlax-erased-p (cadr x))) ss));排除已经删除的图层
        (mapcar '(lambda (y)(vla-put-lock y :vlax-true));锁定
                (mapcar 'cadr (vl-remove-if-not '(lambda (x)(= (car x) 1)) ss))
        )
        (mapcar '(lambda (y)(vla-put-Freeze y :vlax-true));冻结
                (mapcar 'cadr (vl-remove-if-not '(lambda (x)(= (car x) 2)) ss))
        )
        (mapcar '(lambda (y)(vla-put-LayerOn y :vlax-false));关闭
                (mapcar 'cadr (vl-remove-if-not '(lambda (x)(= (car x) 3)) ss))
        )
)
;;提取图层状态
(defun x1812031 ( / lay ss)
        (setq ss '())
        (vlax-for lay (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
                (if (= (vla-get-lock lay) :vlax-true);如果图层锁定
                        (progn
                                (vla-put-lock lay :vlax-false) ;解锁
                                (setq ss (cons (list 1 lay) ss))
                        )
                )
                (if (= (vlax-get-property lay "Freeze") :vlax-true);冻结
                        (progn
                                (vla-put-Freeze lay :vlax-False);解冻
                                (setq ss (cons (list 2 lay) ss))
                        )
                )
                (if (= (vlax-get-property lay "LayerOn") :vlax-false);关闭
                        (progn
                                (vla-put-LayerOn lay :vlax-true);打开
                                (setq ss (cons (list 3 lay) ss))
                        )
                )
        )
        ss
)

GaryZZZ

nyistjz 发表于 2023-9-8 09:00
你试试这个，我平时用的是这个

;================================================================= ...

大佬怎么使用啊，没看懂