MLeader Rou的块属性

iamvadim · 发表于 2022-7-5 16:21:21

你好

我有一个lisp例程，它读取块属性并使用它创建多重引线。读取属性字符串被处理10次，以在每个双空格（“”）处插入回车符。此函数导致CAD崩溃，并返回内存访问异常。它不喜欢使用我的变量，特别是attval（正在处理的块属性中的字符串）。看看下面的lisp，有没有更好、更可靠的方法来管理这些变量？

谢谢
瓦迪姆

-------------------------------------------------------------------------------------------

（命令“_audcallotinsert”e“”p）
（setq xEnt（entlast））
（setq myEnt xEnt）

（setq InsPnt（cdr（assoc 10（entget xEnt）））
（setq insTyp（cdr（assoc 0（entget xEnt）））
（setq insLyr（cdr（assoc 8（entget xEnt）））
; 获取ATTRIBUTE1的值
（虽然
（和
（空值）
（=“ATTRIB”（cdr（assoc 0（setq enx（entget（setq myEnt（entnext myEnt 107;）Ю）Ю））））
)
（if（=（strcase“ATTRIBUTE1”）（strcase（cdr（assoc 2 enx）））
（程序
（setq attval（cdr（assoc 1 enx）））
（setq atthgt（cdr（assoc 40 enx）））
; 将双空格转换为CR/LF
; 命令重复10次，因为函数一次只转换一个字符串
（重复10（setq attval（vl string subst“\r\n”“”attval）））
)
)
)

（entdel xEnt）
（命令“-layer”set“insLyr”）

（setq PT1（getpoint“\n点击引线起点：”）
（setq PT2（getpoint PT1“\n点击着陆点：”）
（命令“_mleader”PT1 PT2 attval）（普林斯）

（命令“-layer”set“curLyr”）

Grrr · 发表于 2022-7-5 16:33:35

如果activex是一个选项：

copy


(vl-load-com)
(and 
 (setq e (car (entsel "\nPick attributed block: ")))
 (setq o (vlax-ename->vla-object e))
 (vlax-write-enabled-p o)
 (eq (vla-get-HasAttributes o) :vlax-true)
 (setq att (vl-some (function (lambda (x) (if (= "ATTRIBUTE1" (strcase (vla-get-TagString x))) x))) (vlax-invoke o 'GetAttributes)))
 (setq attval (vla-get-TextString att))
 (setq atthgt (vla-get-Height att))
 (setq attval (vl-string-translate "\r" " " (vl-string-translate "\n" " " attval)))
 (setq pt1 (getpoint "\nPick start point of leader: "))
 (setq PT2 (getpoint pt1 "\nPick landing point: "))
 (progn
   (command "._MLEADER" pt1 pt2 attval)
   (entmod (append (entget (entlast)) (list (assoc 8 (entget e)))))
   (not (vla-Delete o))
 )
); and

SLW210 · 发表于 2022-7-5 16:39:39

请阅读代码发布指南，并编辑代码以包含在代码标签中。[NOPARSE]

copy

Your Code Here[/NOPARSE]

=

copy

Your Code Here

Tharwat · 发表于 2022-7-5 16:49:24

vl某些函数返回的不是nil或nil。

iamvadim · 发表于 2022-7-5 17:03:20

谢谢你的代码！我有一个机会，但仍然让澳元崩溃时，我运行的例行程序。需要再多玩一点。再次感谢！

Grrr · 发表于 2022-7-5 17:05:43

是的，所以要准确地确定返回什么，焦点必须在（lambda）内-例如：

copy

(vl-some (function (lambda (x) (= "ATTRIBUTE1" (strcase (vla-get-TagString x))))) (vlax-invoke o 'GetAttributes))

可能返回T或nil

以及：

copy

(vl-some (function (lambda (x) (if (= "ATTRIBUTE1" (strcase (vla-get-TagString x))) x))) (vlax-invoke o 'GetAttributes))

可以返回属性对象或nil

BIGAL · 发表于 2022-7-5 17:15:14

lambda的另一种替代方法是根据本例使用foreach

copy


(foreach att (vlax-invoke (vlax-ename->vla-object (ssname SS1 x)) 'getattributes)
   (if (= oldtag1 (strcase (vla-get-tagstring att)))
   (vla-put-textstring att newstr1) 
))

iamvadim · 发表于 2022-7-5 17:27:38

尝试获取属性值的新方法，并在MLeader中使用它，但我在att中没有完全获取值。我在这里旋转轮子，有人能检查一下我是否正确获取了属性吗？完成下面的代码。

作为免责声明，我对AutoLISP非常陌生。希望编辑此函数以消除崩溃。

copy

(defun c:MLCALLOUT (/)
 (vl-load-com)
 (sssetfirst nil nil) ; Deselect everything if anything is selected
 (setq myMode (getvar "tilemode"))      ; myMode=0 means we're in paper space
 (if (= myMode 0) (command ".mspace"))  ; if in paper space, switch to model space
 (setq ss (ssget "_+.:E:S" '((0 . "INSERT,ARC,CIRCLE,*POLYLINE"))))  ; get the entity
 (setq e (ssname ss 0))                 ; get the entity's handle
 (setq p (cadr (cadddr (car (ssnamex ss)))))
 (setq curLyr (getvar "clayer"))
 (setq myScale (getvar "cannoscale"))      ; get the annotation scale
 (setq myScale (atoi (substr myScale 3 (- (strlen myScale) 2)))) ;get the cannoscale
 (if (= myMode 0) (progn (command ".pspace")(setq p (list 0 0 0 ))))  ; if we were in paper space, switch back
 (setq xT (cdr (assoc 0 (entget e))))
 ; AUD insert Callout Command
 (command "_AUDCALLOUTINSERT" e "" p)
 
 (setq xEnt (entlast))
 (setq myEnt xEnt) 
 (setq insLyr (cdr (assoc 8  (entget xEnt))))
 
 ; Get the value of ATTRIBUTE1
 (setq blk (vlax-ename->vla-object myEnt))
 (setq tag "ATTRIBUTE1")
 (vl-some '(lambda ( att ) (if (= tag (strcase (vla-get-tagstring att))) (vla-get-textstring att)))
     (vlax-invoke blk 'getattributes)
 )
 (entdel xEnt) ; Delete the block entity from AUD Callout Command
 (command "-layer" "set" insLyr "") ; Set to callout layer
 ; Create multileader
 (setq PT1 (getpoint "\nPick start point of leader: "))
 (setq PT2 (getpoint PT1 "\nPick landing point: "))
 (command "._mleader" PT1 PT2 att) 
 (command "-layer" "set" curLyr "") ; Restore previous layer
)

[编程交流] MLeader Rou的块属性

发表回复

精选推荐