关于特性匹配的进一步探索
本帖最后由 尘缘一生 于 2024-7-20 06:17 编辑这个功能忘记那几个帖子了，就不贴上了，搜索没找到。
【特性匹配】哪，经常使用的，是单项匹配，并不是组合匹配，组合匹配弄不好，错了你还得回去重做，为了效率反而浪费了时间，
当然，特殊情况下还是偶尔一用，或非为实用主义故意装酷之人！为此，改写代码，融合支持单特性匹配，并整合快选出口，
单特性匹配做了10个常用的。
涉及众多函数，（画图者，非画图工作者除外）有兴趣在三领下测试。
;特性匹配----------------
;;Modify bySLdesign V3.0QQ:15290049 2024年7月20号
(defun c:txpp (/ *error* dcf dch dcl des l l2 ss lis lisf tgassoc tgswitch dokeysys obj tmpl nam1 str fi)
(cond
((= $Lgver 1)
(setq l2
'(
("TextColor" "文字颜色")
("TextStyle" "文字样式")
("TEXT" "标注文字")
("DrawingLabel" "图纸编号")
("ScaleText" "比例文字")
("ImageWidth" "图像宽度")
("ImageHeight" "图像高度")
("TextHeight" "文字高度")
("ToleranceUpperLimit" "上 公 差")
("ToleranceLowerLimit" "下 公 差")
("TextRotation" "文字角度")
("ArrowheadType" "箭头样式")
("EffectiveName" "*块")
("Diameter" "*直径")
("Radius" "*半径")
("AssociativeHatch" "*填充")
("Color" "颜色")
("Layer" "图层")
("LineType" "线型")
("LinetypeScale" "线型比例")
("Lineweight" "线宽")
("ConstantWidth" "整体线宽")
("EntityTransparency" "透明度")
("Material" "材质")
("Rotation" "旋转")
("TextString" "文本内容")
("StyleName" "字体样式")
("Width" "宽度")
("Height" "高度")
("ScaleFactor" "宽高比")
("AttachmentPoint" "多行文字附着点")
("BackgroundFill" "多行文字遮罩")
("LineSpacingDistance""直线间隔距离")
("LineSpacingFactor" "多行文字行间距")
("LineSpacingStyle" "多行文字间距样式")
("XEffectiveScaleFactor" "块X方向有效比例")
("XScaleFactor" "块X比例")
("YEffectiveScaleFactor" "块Y方向有效比例")
("YScaleFactor" "块Y比例")
("ZEffectiveScaleFactor" "块Z方向有效比例")
("ZScaleFactor" "块Z比例")
)
)
)
((= $Lgver 2) ;繁体版
(setq l2
'(
("TextColor" "ゅ肅︹")
("TextStyle" "ゅ妓Α")
("TEXT" "夹猔ゅ")
("DrawingLabel" "瓜絪腹")
("ScaleText" "ゑㄒゅ")
("ImageWidth" "瓜钩糴")
("ImageHeight" "瓜钩蔼")
("TextHeight" "ゅ蔼")
("ToleranceUpperLimit" " そ 畉")
("ToleranceLowerLimit" " そ 畉")
("TextRotation" "ゅà")
("ArrowheadType" "絙繷妓Α")
("EffectiveName" "*遏")
("Diameter" "*畖")
("Radius" "*畖")
("AssociativeHatch" "*恶")
("Color" "肅︹")
("Layer" "瓜糷")
("LineType" "絬")
("LinetypeScale" "絬ゑㄒ")
("Lineweight" "絬糴")
("ConstantWidth" "俱砰絬糴")
("EntityTransparency" "硓")
("Material" "借")
("Rotation" "臂锣")
("TextString" "ゅセず甧")
("StyleName" "砰妓Α")
("Width" "糴")
("Height" "蔼")
("ScaleFactor" "糴蔼ゑ")
("AttachmentPoint" "︽ゅ帝翴")
("BackgroundFill" "︽ゅ綛竛")
("LineSpacingDistance""絬丁筳禯瞒")
("LineSpacingFactor" "︽ゅ︽丁禯")
("LineSpacingStyle" "︽ゅ丁禯妓Α")
("XEffectiveScaleFactor" "遏XよΤゑㄒ")
("XScaleFactor" "遏Xゑㄒ")
("YEffectiveScaleFactor" "遏YよΤゑㄒ")
("YScaleFactor" "遏Yゑㄒ")
("ZEffectiveScaleFactor" "遏ZよΤゑㄒ")
("ZScaleFactor" "遏Zゑㄒ")
)
)
)
((= $Lgver 3)
(setq l2
'(
("TextColor" "TextColor")
("TextStyle" "TextStyle")
("TEXT" "TEXT")
("DrawingLabel" "DrawingLabel")
("ScaleText" "ScaleText")
("ImageWidth" "ImageWidth")
("ImageHeight" "ImageHeight")
("TextHeight" "TextHeight")
("ToleranceUpperLimit" "ToleranceUpperLimit")
("ToleranceLowerLimit" "ToleranceLowerLimit")
("TextRotation" "TextRotation")
("ArrowheadType" "ArrowheadType")
("EffectiveName" "*EffectiveName")
("Diameter" "*Diameter")
("Radius" "*Radius")
("AssociativeHatch" "*AssociativeHatch")
("Color" "Color")
("Layer" "Layer")
("LineType" "LineType")
("LinetypeScale" "LinetypeScale")
("Lineweight" "Lineweight")
("ConstantWidth" "ConstantWidth")
("EntityTransparency" "EntityTransparency")
("Material" "Material")
("Rotation" "Rotation")
("TextString" "TextString")
("StyleName" "StyleName")
("Width" "Width")
("Height" "Height")
("ScaleFactor" "ScaleFactor")
("AttachmentPoint" "AttachmentPoint")
("BackgroundFill" "BackgroundFill")
("LineSpacingDistance""LineSpacingDistance")
("LineSpacingFactor" "LineSpacingFactor")
("LineSpacingStyle" "LineSpacingStyle")
("XEffectiveScaleFactor" "XEffectiveScaleFactor")
("XScaleFactor" "XScaleFactor")
("YEffectiveScaleFactor" "YEffectiveScaleFactor")
("YScaleFactor" "YScaleFactor")
("ZEffectiveScaleFactor" "ZEffectiveScaleFactor")
("ZScaleFactor" "ZScaleFactor")
)
)
)
)
;切换关联器 - 将切换值（0 或 1）与符号值（nil 或 T）:
(defun tgassoc (keyorval) (cadr (assoc keyorval '((nil "0") (T "1") ("0" nil) ("1" T)))))
;切换开关 - 切换切换的值
(defun tgswitch (key) (set_tile key (cadr (assoc (get_tile key) '(("0" "1") ("1" "0"))))))
;-------------
(defun dokeysys (ss l / i o nam tp d)
(repeat (setq i (sslength ss))
(setq o (en2obj (setq nam (ssname ss (setq i (1- i))))))
(mapcar
(function
(lambda (x)
(setq tp (car x) d (cadr x))
(cond
((= tp "Color")
(slchcol (ssadd nam) d)
)
((and
(= tp "TextString")
(/= (vlax-property-available-p o "TextString") nil)
)
(chzi-enam nam d)
)
((and
(= tp "Height")
(/= (vlax-property-available-p o "Height") nil)
)
(ss-ch-z-hi (ssadd nam) d (cadr (grread 5)))
)
((and (= tp "ConstantWidth") (> d 0)) ;线宽
(gx (ssadd nam) d)
)
((= tp "EffectiveName") ;块作拷贝
(vla-move (vla-copy obj) (vlax-3D-point (e-mid nam1)) (vlax-3D-point (e-mid nam)))
(entdel nam)
)
((= tp "AssociativeHatch") ;填充
(if (vl-catch-all-error-p (vl-catch-all-apply '(lambda () (command "_MATCHPROP" nam1 nam ""))))
(entmod (emod (emod (emod (emod (emod nam 2 (dxf1 nam1 2)) 52 (angle-sharp (dxf1 nam1 52))) 41 (dxf1 nam1 41)) 62 (dxf1 nam1 62)) 8 (dxf1 nam1 8)))
)
)
(t (vl-catch-all-apply 'vlax-put (list o tp d)))
)
)
)
l
)
)
)
;-------------
(defun *error* (ms)
(and (< 0 dch) (unload_dialog dch))
(and (eq 'FILE (type des)) (close des))
(and (eq 'STR (type dcl)) (findfile dcl) (vl-file-delete dcl))
(and ms (or (wcmatch (strcase ms) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n Error:" ms))))
(princ)
)
;;--主程序----
(setvar 'errno 0)
(while (/= 52 (getvar 'errno))
(setq nam1 (car (entsel (slmsg "\n 选择源对象:" "\n 腢埭?砓:" "\n Select Source Object:"))))
(cond
((= 7 (getvar 'errno)) (princ (slmsg "\n 错误,重试!" "\n 岿粇,刚!" "\n Error, retry!")) (setvar 'errno 0))
(nam1 (setq obj (en2obj nam1)) (setvar 'errno 52))
)
)
(setq l
(apply 'append
(mapcar
(function
(lambda (x)
(cond
((and
(vlax-property-available-p obj x)
(not (member x '("Color" "ConstantWidth" "TextString")))
)
(list (list x (vlax-get obj x))) ;(vlax-get (en2obj (car(entsel))) "ScaleFactor")
)
((= x "TextString")
(list (list x (getstr nam1)))
)
((= x "Color")
(list (list x (sl-getcolor nam1)))
)
((= x "ConstantWidth") ;线宽
(list (list x (linwind nam1)))
)
)
)
)
'("Color" "Layer" "LineType" "LinetypeScale" "Lineweight" "ConstantWidth" "EffectiveName" "Diameter" "Radius" "AssociativeHatch"
"EntityTransparency" "Material" "Rotation" "TextString" "StyleName" "Width" "Height" "ScaleFactor"
"AttachmentPoint" "BackgroundFill" "LineSpacingDistance" "LineSpacingFactor" "LineSpacingStyle"
"XEffectiveScaleFactor" "XScaleFactor" "YEffectiveScaleFactor" "YScaleFactor" "ZEffectiveScaleFactor" "ZScaleFactor"
"TextColor" "TextStyle" "TEXT" "DrawingLabel" "ScaleText" "ImageWidth" "ImageHeight" "TextHeight" "ToleranceUpperLimit" "ToleranceLowerLimit"
"TextRotation" "ArrowheadType"
)
)
)
fi (strcat sl-path0 "\\support\\" "txpp.ini")
)
;取得样本obj VLA特性表 如下ConstantWidth
;(("Color" 256) ("Layer" "510") ("LineType" "ByLayer") ("LinetypeScale" 1.0) ("Lineweight" -1) ("EntityTransparency" "ByLayer")
;("Material" "ByLayer") ("Rotation" 0.0) ("TextString"; "圆管300X7") ("StyleName" "Standard") ("Height" 2.5))
(cond
((progn (and (setq ss (cadr (ssgetfirst))) (sssetfirst nil nil)) nil))
((progn
(while (not (member dcf '(0 1 2 3 4 5 6 7 8 9 10 11 12)))
(*error* nil)
(if l
(progn
(setq lis (xl-div l (fix (* 0.4 (length l)))) lisf '()) ;分组
(while lis
(setq lisf
(append
lisf
(list
$column
":tile {}"
(apply 'strcat
(mapcar
(function
(lambda (x)
(strcat ":toggle{label=\"" (cadr (assoc (car x) l2)) "\"; key=\"" (car x) "\";value=" (if (readkey fi (car x)) "1" "0") ";}")
)
)
(car lis)
)
)
"}"
)
)
)
(setq lis (cdr lis))
)
)
)
(cond
((not ;连续重写并重新加载对话框
(and (setq dcl (vl-filename-mktemp nil nil ".dcl")) (setq des (open dcl "w"))
(vl-every (function (lambda (x) (write-line x des)))
(append
(list
"MyMatchProps:dialog"
(slmsg
"{label=\"三领设计 V3.0 匹配特性\";"
"{label=\"烩砞璸 V3.0 で皌疭┦\";"
"{label=\"Sldesign V3.0 Matching characteristics\";"
)
$row
$boxed_row
(slmsg "label=\"单项匹配\";" "label=\"虫兜で皌\";" "label=\"Single item matching\";")
$column
(strcat ":button {label=\"" (slmsg "文字内容" "ゅず甧" "Text Content") "\"; key=\"txtstr\";}")
(strcat ":button {label=\"" (slmsg "文字高度" "ゅ蔼" "Text Height") "\"; key=\"txth\";}")
(strcat ":button {label=\"" (slmsg "文字角度" "ゅà" "Text Ang") "\"; key=\"txta\";}")
(strcat ":button {label=\"" (slmsg "字体样式" "砰妓Α" "Text Style") "\"; key=\"txtsty\";}")
(strcat ":button {label=\"" (slmsg "宽 高 比" "糴 蔼 ゑ" "ScaleFactor") "\"; key=\"txt41\";}")
"}"
$column
(strcat ":button {label=\"" (slmsg "颜色" "肅︹" "Colour") "\"; key=\"kcol\";}")
(strcat ":button {label=\"" (slmsg "图层" "瓜糷" "Layer") "\"; key=\"klay\";}")
(strcat ":button {label=\"" (slmsg "线宽" "絬糴" "linwidth") "\"; key=\"klw\";}")
(strcat ":button {label=\"" (slmsg "线型" "絬" "Linetype") "\"; key=\"klt\";}")
(strcat ":button {label=\"" (slmsg "线比" "絬ゑ" "LinetypeScale") "\"; key=\"klsc\";}")
"}"
"}"
$boxed_column
(slmsg "label=\"组合匹配\";" "label=\"舱で皌\";" "label=\"Combination matching\";")
$row
)
lisf
(list
"}"
$row
(strcat ":button {label=\"" (slmsg "->执行" "磅︽匡" "Execute to Selec.") "\";key=\"accept\";is_default=true;}")
(strcat ":button {label=\"" (slmsg "->快选" "->е匡" "->Choose quickly") "\"; key=\"ksuan\";}")
":button {label=\"Switch\"; key=\"Switch\";mnemonic=\"t\";}"
":text{key=\"error\";}"
"}"
"}"
"}"
$row
":tile {}:tile {}:tile {}"
$canbt
":tile {}:tile {}:tile {}"
"}"
"}"
)
)
)
(not (setq des (close des))) (< 0 (setq dch (load_dialog dcl)))
)
)
(princ (slmsg "\n 无法写入或加载DCL文件." "\n 礚猭糶┪更DCLゅン." "\n Unable to write or load DCL file.")) (setq dcf 0)
)
((not (new_dialog "MyMatchProps" dch)) (princ (slmsg "\n 无法显示对话框" "\n 礚猭陪ボ癸杠" "\n Unable to display dialog box")) (setq dcf 0))
(T
(if tmpl (mapcar (function (lambda (x) (set_tile (car x) (cdr x)))) tmpl))
(action_tile "Switch"
(vl-prin1-to-string
'(progn
(mapcar (function (lambda (x) (tgswitch x))) (mapcar 'car l))
(setq tmpl (mapcar (function (lambda (x) (cons x (get_tile x)))) (mapcar 'car l)))
)
)
)
(if l
(vl-every
(function
(lambda (x)
(action_tile (car x)
(vl-prin1-to-string
'(cond
((assoc $key tmpl) (setq tmpl (subst (cons $key $value) (assoc $key tmpl) tmpl)))
((setq tmpl (cons (cons $key $value) tmpl)))
)
)
)
)
)
l
)
)
(action_tile "accept"
(vl-prin1-to-string
'(cond
((not l) (set_tile "error" (slmsg "检查上面的消息!" "浪琩!" "Check the message above!")))
((setq l (mapcar (function (lambda (x) (append x (list (get_tile (car x)))))) l))
(done_dialog 1)
)
)
)
)
(action_tile "kcol" "(done_dialog 2)")
(action_tile "klay" "(done_dialog 3)")
(action_tile "klw" "(done_dialog 4)")
(action_tile "klt" "(done_dialog 5)")
(action_tile "klsc" "(done_dialog 6)")
(action_tile "txtstr" "(done_dialog 7)")
(action_tile "txth" "(done_dialog 8)")
(action_tile "txta" "(done_dialog 9)")
(action_tile "txtsty" "(done_dialog 10)")
(action_tile "txt41" "(done_dialog 11)")
(action_tile "ksuan"
(vl-prin1-to-string
'(cond
((not l) (set_tile "error" (slmsg "检查上面的消息!" "浪琩!" "Check the message above!")))
((setq l (mapcar (function (lambda (x) (append x (list (get_tile (car x)))))) l))
(done_dialog 12)
)
)
)
)
(setq dcf (start_dialog))
)
)
) ;while
(/= 1 dcf)
)
(princ (slmsg "\n 用户取消了对话框." "\n ノめ癸杠." "\n The user cancelled the dialog box."))
)
)
(cond
((= dcf 1)
(setq l (vl-remove-if (function (lambda (x) (not (tgassoc (caddr x))))) l))
)
((= dcf 2)
(setq l (list (list "Color" (sl-getcolor nam1))))
)
((= dcf 3)
(setq l (list (list "Layer" (dxf1 nam1 8))))
)
((= dcf 4)
(setq l (list (list "ConstantWidth" (linwind nam1))))
)
((= dcf 5)
(setq l (list (list "LineType" (sl-linetype nam1))))
)
((= dcf 6)
(setq l (list (list "LinetypeScale" (vla-get-LinetypeScale obj))))
)
((= dcf 7)
(setq l (list (list "TextString" (getstr nam1))))
)
((= dcf 8)
(setq l (list (list "Height" (e-higt nam1))))
)
((= dcf 9)
(setq l (list (list "Rotation" (e-ang nam1 nil))))
)
((= dcf 10)
(setq l (list (list "StyleName" (dxf1 nam1 7))))
)
((= dcf 11)
(setq l (list (list "ScaleFactor" (dxf1 nam1 41))))
)
((= dcf 12)
(setq ss (sl-fs-ss-1 nam1))
)
)
(if (and l ss)
(dokeysys ss l)
(progn
(princ (setq str (slmsg "\n 选择目标对象:" "\n 匡拒ヘ夹癸禜:" "\n Select Target Object:")))
(while (setq ss (ssget ":S"))
(dokeysys ss l)
(princ str)
)
)
)
(sl:del-fil fi)
(if l (mapcar '(lambda (x) (rwritekey fi (car x) "1")) l)) ;(("LinetypeScale" 1.0 "1") ("Lineweight" -1 "1") ("ConstantWidth" 0.25 "1") ("TextString" "12" "1"))
(*error* nil) (princ)
)
测试：
链接：https://pan.baidu.com/s/1xImgCjkK-bKeknc4ALHVwA
提取码：v9s8
大佬文字是语音输入的吗？ 怎么这么多乱码 再进一步探索,你就会发现索引了 这个好，很实用。
页:
[1]