生成对象的选择集
大家好,我花了整个周末的时间在Afralisp、谷歌和其他各种资源上,我是一个Lisp程序的新手,这将是我的第一个中级(我敢说)例程,不过应该感谢那些已经为我的各种参考资源做出贡献的人!
常规:
复制多重引线>分解副本>删除引线组件>将文本放置在基于原始层但带有后缀的唯一层上。
我正在努力解决的是,多行文字没有继承原始多重引线的注释性比例(只有当前比例),我不知道如何制作所述比例的选择集,以便我可以将它们添加回复制的多行文字。
到目前为止,代码要温和:
;============================================================
;MLeader Halo____G Beaumont 01/04/13
;============================================================
(defun c:ML2HALO ( / msel1 sfx msel2 oldlayer ent entdata lay1 lay_name)
(Princ "\nSelect Mleader or Dimension to HALO (CAN NOT be a true type font)...")
(setq msel1 (ssget))
(setq sfx "_HALO")
(command "copy" msel1 "" "0,0" "0,0")
(setq msel2 (ssget "p"))
(setvar "qaflags" 1)
(command "_.explode" msel2 "")
(setvar "qaflags" 0)
(setq msel2 (ssget "p"))
(ssget "p" '((-4 . "<not") (0 . "Mtext") (-4 . "not>")))
(command "erase" "p" "")
;============================================================
;Layer control
;============================================================
(setq oldlayer (getvar "CLAYER"))
(entlast)
(setq ent (entlast))
(setq entdata (entget ent))
(assoc 8 entdata)
(cdr (assoc 8 entdata))
(setq lay1 (cdr (assoc 8 entdata)))
(setq lay_name (strcat lay1 sfx))
(command "-LAYER" "M" lay_name "LW" "2" "" "C" "255" "" "")
(command "_chprop" msel2 "" "LA" lay_name "C" "bylayer" "Annotative" "yes" "")
(setvar "CLAYER" oldlayer)
(princ)
)
;============================================================
;End
;============================================================
您需要做的是“抓取”mleader对象的当前Annoscale并将其应用于ent。但这将假设所有选定的多重引线具有相同的annoscale。[简单部分]
(Defun GetAnnoscale (ed / scLst)
;;; Irné ;;;
(if (and
;; Get the XDictionary attached to the object
(setq xn (vl-position '(102 . "{ACAD_XDICTIONARY") ed))
(setq xn (cdr (nth (1+ xn) ed)))
(setq xd (entget xn))
;; Get the Context Data Management dictionary attached to the XDictionary
(setq cdn (vl-position '(3 . "AcDbContextDataManager") xd))
(setq cdn (cdr (nth (1+ cdn) xd)))
(setq cdd (entget cdn))
;; Get the Annotation Scales dictionary attached to the CD
(setq asn (vl-position '(3 . "ACDB_ANNOTATIONSCALES") cdd))
(setq asn (cdr (nth (1+ asn) cdd)))
(setq asd (entget asn))
;; Get the 1st scale attached
(setq cn (assoc 3 asd))
(setq cn (member cn asd))
)
;; Step through all scales attached
(while cn
(if (and (= (caar cn) 350) ;It it's pointing to a scale record
;; Get the record's data
(setq cd (entget (cdar cn)))
;; Get the Context data class
(setq sn (assoc 340 cd))
(setq sd (entget (cdr sn)))
(setq sn (assoc 300 sd))
;; Check if the scale is already in the list
(not (vl-position (cdr sn) scLst))
)
(setq scLst (cons (cdr sn) scLst))
)
(setq cn (cdr cn))
)
) scLst
)
否则,您需要遍历选定的多重引线实体,并逐个分解项目。
如果你需要帮助,就喊一声 非常感谢pBe,
我会找一个安静的角落,交叉双腿,慢慢地摇晃,试着消化我不懂的20个左右的新命令,包括我还没有开始学习的VL东西 :lol:pBe代码中唯一的VL是VL位置。这是一个相当简单的方法,它是第n个函数的逆。假设您有一个整数列表,并希望找到特定整数在该列表中的位置:
(setq sampleList '(6 2 4 5 1 )
(vl-position 4sampleList) ;Returns 2 as the 0-based index position
(nth 2 sampleList) ;Returns 4 as the item at position 2
至于那段代码,我有点为我在里面做的那些多余的东西感到羞愧,这些东西都是不必要的。还有其他一些方法可以解决同样的问题。最值得注意的是dict*函数,这是使用词典的“官方”方式。有关my functions的一些更新版本,请查看以下lisp:http://sourceforge.net/p/caddons/code/67/tree/General/Scales.LSP
基本上,anno比例作为类似XRecord的实体列在图形附带的字典中(即,附加到namedobjdict实体附带的“ACAD\u SCALELIST”字典)。然后,每个应用了刻度的实体都会在其XDictionary上附加一个字典,这取决于它可能是“ACDB_ANNOTATIONSCALES”或“ASDK_XREC_ANNOTATION_SCALE_INFO”的实体类型。然后,它包含一个或多个到ACAD_比例列表中主比例的链接。这听起来有点复杂,但这在使用字典时是“常见的”。
我糟糕的Irné,我刚刚粘贴了我看到的第一个处理Annocscales的例程。这几天我在写代码方面有点懒惰。
干杯
我稍后会看看你的新版本。 谢谢irneb,我会消化的!!
页:
[1]