关于特性匹配的进一步探索

尘缘一生 · 发表于 2024-7-20 06:05:05

本帖最后由尘缘一生于 2024-7-20 06:17 编辑

这个功能忘记那几个帖子了，就不贴上了，搜索没找到。

【特性匹配】哪，经常使用的，是单项匹配，并不是组合匹配，组合匹配弄不好，错了你还得回去重做，为了效率反而浪费了时间，
当然，特殊情况下还是偶尔一用，或非为实用主义故意装酷之人！为此，改写代码，融合支持单特性匹配，并整合快选出口，
单特性匹配做了10个常用的。
涉及众多函数，（画图者，非画图工作者除外）有兴趣在三领下测试。

;特性匹配----------------
;;Modify by SLdesign V3.0 QQ: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)
)

;特性匹配---------------- 
;;Modify by  SLdesign V3.0  QQ: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

MZ_li · 发表于 2024-7-20 08:10:36

大佬文字是语音输入的吗？

gble119 · 发表于 2024-7-20 18:44:15

怎么这么多乱码

你有种再说一遍 · 发表于 2024-7-20 20:33:06

再进一步探索,你就会发现索引了

hubeiwdlue · 发表于 2024-7-21 00:14:08

这个好，很实用。

账号		自动登录	找回密码
密码			注册

关于特性匹配的进一步探索

本帖子中包含更多资源

点评

评分

点评

点评