字典操作
本帖最后由 dcl1214 于 2025-6-1 14:30 编辑字典操作，一起测试
感谢石总帮助
(defun $zi-dian-xie-ru$
(ent name values lst /
_setxrecord alls dict dicts
list->vbarray news obj obj0
olds xd xlst xrec xt
)
;字典写入
;($zi-dian-xie-ru$(CAR (entsel))"ZXCAD" '((1000 . "HELLO WORLD") (1070 . 1) (1040 . 1.0))nil)
(defun _setxrecord (obj lst)
(vla-setxrecorddata
obj
(list->vbarray (mapcar 'car lst) vlax-vbinteger)
(list->vbarray (mapcar 'cdr lst) vlax-vbvariant)
)
)
(defun list->vbarray (ptsList TYPE1 / arraySpace sArray)
(setq arraySpace
(vlax-make-safearray
TYPE1
(cons 0 (- (length ptsList) 1))
)
)
(setq sArray (vlax-safearray-fill arraySpace ptsList))
(vlax-make-variant sArray)
)
(if (and ent (= (type ent)) 'ename)
(setq obj0 (vlax-ename->vla-object ent))
)
(and obj0 (setq obj (VLA-GetExtensionDictionary obj0)))
(if (= (vla-get-objectname obj) "AcDbDictionary")
(progn
(vlax-for d obj
(if (and (= (vla-get-objectname d) "AcDbXrecord")
(= (strcase (vla-get-name d)) (strcase name))
)
(setq xrec d)
)
)
(if xrec
(progn
(vla-getxrecorddata xrec 'xt 'xd)
(if xt
(progn
(setq olds
(mapcar 'cons
(safearray-value xt)
(mapcar 'variant-value (safearray-value xd))
)
)
(setq
alls (vl-remove nil (append olds values))
)
(cond
((vl-position (cdr (assoc "模式" lst)) (list "追加"))
(setq news alls)
)
(t (setq news values))
)
(_setxrecord xrec news)
)
(_setxrecord xrec values)
)
)
(progn
(setq xrec (vla-addxrecord obj name))
(_setxrecord xrec values)
)
)
)
(if (= (vla-get-hasExtensionDictionary obj) :vlax-true)
(progn
(setq dicts (vla-GetExtensionDictionary obj))
(vlax-for dict dicts
(if (and (= (vla-get-objectname dict) "AcDbXrecord")
(= (strcase (vla-get-name dict)) (strcase name))
)
(setq xrec dict)
)
)
(if xrec
(progn
(vla-getxrecorddata xrec 'xt 'xd)
(_setxrecord
xrec
(append
(mapcar 'cons
(safearray-value xt)
(mapcar 'variant-value (safearray-value xd))
)
values
)
)
)
)
)
(progn
(setq dict (vla-getextensiondictionary obj)
xrec (vla-addxrecord dict name)
)
(_setxrecord xrec values)
)
)
)
($zi-dian-du-qu$ ent "*" nil)
)
(defun $zi-dian-du-qu$
(ent name lst / _getxrecord dicts e obj obj0 xd xt)
;字典读取
;($zi-dian-du-qu$(CAR (entsel)) "*"nil)
;($zi-dian-du-qu$(CAR (entsel)) "ZXCAD"nil)
(defun _getxrecord (dc / xt xd)
(if (= (vla-get-objectname dc) "AcDbXrecord")
(progn (vla-getxrecorddata dc 'xt 'xd)
(if (and xt xd)
(setq lst
(cons
(cons (vla-get-name dc)
(mapcar
'cons
(safearray-value xt)
(mapcar 'variant-value (safearray-value xd))
)
)
lst
)
)
(setq lst (cons (vla-get-name dc) lst))
)
)
)
)
(if (and ent (= (type ent)) 'ename)
(setq obj0 (vlax-ename->vla-object ent))
)
(and obj0 (setq obj (VLA-GetExtensionDictionary obj0)))
(if (= (vla-get-objectname obj) "AcDbDictionary")
(vlax-for dict obj (_getxrecord dict))
(if (= (vla-get-hasExtensionDictionary obj) :vlax-true)
(progn (setq dicts (vla-GetExtensionDictionary obj))
(vlax-for dict dicts (_getxrecord dict))
)
)
)
(if
(= name "*")
lst
(vl-remove-if-not
(function (lambda (x) (= (strcase (car x)) (strcase name))))
lst
)
)
)
(defun $zi-dian-shan-chu$
(ent name vars lst / E1 obj obj0 OLDS SS TF X)
;字典删除
;($zi-dian-shan-chu$(CAR (entsel)) "ZXCAD" '((1070 . 1) (1040 . 2.0))nil)
(if (and ent (= (type ent)) 'ename)
(setq obj0 (vlax-ename->vla-object ent))
)
(and obj0 (setq obj (VLA-GetExtensionDictionary obj0)))
(if (setq OLDS ($zi-dian-du-qu$ ent name NIL))
(progn
(setq olds (cdr (assoc name OLDS)))
(COND
((AND obj name vars)
(setq OLDS (vl-remove-if
(function (lambda (a) (assoc (car a) vars)))
OLDS
)
)
(if OLDS
($zi-dian-xie-ru$ ent name OLDS lst)
)
)
(T
(if (= (vla-get-objectname obj) "AcDbDictionary")
(vlax-for d obj
(if (= (vla-get-objectname d) "AcDbXrecord")
(if (= name "*")
(vla-delete d)
)
(if (= (strcase (vla-get-name d)) (strcase name))
(vla-delete d)
)
)
)
(if (vla-get-hasextensiondictionary obj)
(vlax-for d (vla-getextensiondictionary obj)
(if (= (vla-get-objectname d) "AcDbXrecord")
(if (= name "*")
(vla-delete d)
)
(if (= (strcase (vla-get-name d)) (strcase name))
(vla-delete d)
)
)
)
)
)
)
)
(setq OLDS ($zi-dian-du-qu$ ent name NIL))
)
)
OLDS
)
(defun $zi-dian-xie-ru$
(ent name values lst /
_setxrecord alls dict dicts
list->vbarray news obj obj0
olds xd xlst xrec xt
)
;字典写入
;($zi-dian-xie-ru$(CAR (entsel))"ZXCAD" '((1000 . "HELLO WORLD") (1070 . 1) (1040 . 1.0))nil)
(defun _setxrecord (obj lst)
(vla-setxrecorddata
obj
(list->vbarray (mapcar 'car lst) vlax-vbinteger)
(list->vbarray (mapcar 'cdr lst) vlax-vbvariant)
)
)
(defun list->vbarray (ptsList TYPE1 / arraySpace sArray)
(setq arraySpace
(vlax-make-safearray
TYPE1
(cons 0 (- (length ptsList) 1))
)
)
(setq sArray (vlax-safearray-fill arraySpace ptsList))
(vlax-make-variant sArray)
)
(if (and ent (= (type ent)) 'ename)
(setq obj0 (vlax-ename->vla-object ent))
)
(and obj0 (setq obj (VLA-GetExtensionDictionary obj0)))
(if (= (vla-get-objectname obj) "AcDbDictionary")
(progn
(vlax-for d obj
(if (and (= (vla-get-objectname d) "AcDbXrecord")
(= (strcase (vla-get-name d)) (strcase name))
)
(setq xrec d)
)
)
(if xrec
(progn
(vla-getxrecorddata xrec 'xt 'xd)
(if xt
(progn
(setq olds
(mapcar 'cons
(safearray-value xt)
(mapcar 'variant-value (safearray-value xd))
)
)
(setq
alls (vl-remove nil (append olds values))
)
(cond
((vl-position (cdr (assoc "模式" lst)) (list "追加"))
(setq news alls)
)
(t (setq news values))
)
(_setxrecord xrec news)
)
(_setxrecord xrec values)
)
)
(progn
(setq xrec (vla-addxrecord obj name))
(_setxrecord xrec values)
)
)
)
(if (= (vla-get-hasExtensionDictionary obj) :vlax-true)
(progn
(setq dicts (vla-GetExtensionDictionary obj))
(vlax-for dict dicts
(if (and (= (vla-get-objectname dict) "AcDbXrecord")
(= (strcase (vla-get-name dict)) (strcase name))
)
(setq xrec dict)
)
)
(if xrec
(progn
(vla-getxrecorddata xrec 'xt 'xd)
(_setxrecord
xrec
(append
(mapcar 'cons
(safearray-value xt)
(mapcar 'variant-value (safearray-value xd))
)
values
)
)
)
)
)
(progn
(setq dict (vla-getextensiondictionary obj)
xrec (vla-addxrecord dict name)
)
(_setxrecord xrec values)
)
)
)
($zi-dian-du-qu$ ent "*" nil)
)
(defun $zi-dian-du-qu$
(ent name lst / _getxrecord dicts e obj obj0 xd xt)
;字典读取
;($zi-dian-du-qu$(CAR (entsel)) "*"nil)
;($zi-dian-du-qu$(CAR (entsel)) "ZXCAD"nil)
(defun _getxrecord (dc / xt xd)
(if (= (vla-get-objectname dc) "AcDbXrecord")
(progn (vla-getxrecorddata dc 'xt 'xd)
(if (and xt xd)
(setq lst
(cons
(cons (vla-get-name dc)
(mapcar
'cons
(safearray-value xt)
(mapcar 'variant-value (safearray-value xd))
)
)
lst
)
)
(setq lst (cons (vla-get-name dc) lst))
)
)
)
)
(if (and ent (= (type ent)) 'ename)
(setq obj0 (vlax-ename->vla-object ent))
)
(and obj0 (setq obj (VLA-GetExtensionDictionary obj0)))
(if (= (vla-get-objectname obj) "AcDbDictionary")
(vlax-for dict obj (_getxrecord dict))
(if (= (vla-get-hasExtensionDictionary obj) :vlax-true)
(progn (setq dicts (vla-GetExtensionDictionary obj))
(vlax-for dict dicts (_getxrecord dict))
)
)
)
(if
(= name "*")
lst
(vl-remove-if-not
(function (lambda (x) (= (strcase (car x)) (strcase name))))
lst
)
)
)
(defun $zi-dian-shan-chu$
(ent name vars lst / E1 obj obj0 OLDS SS TF X)
;字典删除
;($zi-dian-shan-chu$(CAR (entsel)) "ZXCAD" '((1070 . 1) (1040 . 2.0))nil)
(if (and ent (= (type ent)) 'ename)
(setq obj0 (vlax-ename->vla-object ent))
)
(and obj0 (setq obj (VLA-GetExtensionDictionary obj0)))
(if (setq OLDS ($zi-dian-du-qu$ ent name NIL))
(progn
(setq olds (cdr (assoc name OLDS)))
(COND
((AND obj name vars)
(setq OLDS (vl-remove-if
(function (lambda (a) (assoc (car a) vars)))
OLDS
)
)
(if OLDS
($zi-dian-xie-ru$ ent name OLDS lst)
)
)
(T
(if (= (vla-get-objectname obj) "AcDbDictionary")
(vlax-for d obj
(if (= (vla-get-objectname d) "AcDbXrecord")
(if (= name "*")
(vla-delete d)
)
(if (= (strcase (vla-get-name d)) (strcase name))
(vla-delete d)
)
)
)
(if (vla-get-hasextensiondictionary obj)
(vlax-for d (vla-getextensiondictionary obj)
(if (= (vla-get-objectname d) "AcDbXrecord")
(if (= name "*")
(vla-delete d)
)
(if (= (strcase (vla-get-name d)) (strcase name))
(vla-delete d)
)
)
)
)
)
)
)
(setq OLDS ($zi-dian-du-qu$ ent name NIL))
)
)
OLDS
)
;
(defun $objid>ent$ (objID / ent)
(if objID
(setq ent (vl-catch-all-apply
'vlax-vla-object->ename
(list
(vl-catch-all-apply
'vla-ObjectIdToObject
(list
(vla-get-activedocument (vlax-get-acad-object))
objID
)
)
)
)
)
)
(if (vl-catch-all-error-p ent)
(setq ent nil)
)
ent
)
;
(defun MKEn001 (insertpt jd / obj obj1 axErr basept insertpt axErr1 HatchobjAray ExplodeList objary objLay LineTypeErr objStyle entdata enMlStyle flag ACAD_MLINESTYLE osmode cmdecho filedia)
(setq osmode (getvar "osmode") cmdecho (getvar "cmdecho") filedia (getvar "filedia"))
(mapcar 'setvar '("osmode" "cmdecho" "filedia") '(0 0 0))
(setq basept '(0.000000000000000 0.000000000000000 0.000000000000000))
(setvar "osmode" 15359)
;(setq insertpt (getpoint "\选择插入基点<0,0,0>："))
(setvar "osmode" 0)
(if (null insertpt) (setq insertpt '(0 0 0)))
;;;******本函数代码由Gu_xl的自动Lisp代码生成器自动生成******
(cond ((not (TBLSEARCH "block" "yyy12345"))
(setvar "clayer" "0")
(setq obj (vla-add (vla-get-Blocks (vla-get-activedocument (vlax-get-acad-object))) (vlax-3d-point '(0 0 0)) "yyy12345"))
(vla-put-color (vla-item (vla-get-Layers (vla-get-activedocument (vlax-get-acad-object))) "0") "7")
(setvar "Clayer" "0")
(setvar "CeColor" "256")
(setq axErr (VL-CATCH-ALL-APPLY 'vla-load (list (vla-get-Linetypes (vla-get-activedocument (vlax-get-acad-object))) "ByLayer" "acadiso.lin")))
(if (VL-CATCH-ALL-ERROR-P axErr) (setq axErr (VL-CATCH-ALL-APPLY 'vla-load (list (vla-get-Linetypes (vla-get-activedocument (vlax-get-acad-object))) "ByLayer" "EstateCADTools.lin"))))
(if (not (VL-CATCH-ALL-ERROR-P axErr)) (setvar "CeLtype" "ByLayer"))
(setvar "CeLTScale" 8.00000000)
(setvar "CeLweight" -1)
(setq obj1 (vla-AddLightWeightPolyline obj (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbdouble (cons 1 28))'(-0.0144651222462674 -0.4053455131440885 -0.0145257768700013 -0.3825020637239967 0.0165568161537094 -0.3824195322748336 0.0166460323127025 -0.4160196882061602 0.0004574601199830 -0.4220542435516649 -0.1403521516702209 -0.4383852072630968 -0.1687346743282201 -0.4767672243487655 -0.1680778656339516 -0.7241313206464043 -0.1394919184126529 -0.7623620733130406 0.0014024322404991 -0.7779450480700849 0.0176228222128363 -0.7838935501506218 0.0177120383718294 -0.8174937060819484 -0.0133705546518813 -0.8175762375311116 -0.0134312092756151 -0.7947327881110198)))))
(vla-SetBulge obj1 5 0.3310486734302698)
(vla-SetBulge obj1 7 0.3310486734302700)
(vla-put-color (vla-item (vla-get-Layers (vla-get-activedocument (vlax-get-acad-object))) "0") "7")
(setvar "Clayer" "0")
(setvar "CeColor" "256")
(setq axErr (VL-CATCH-ALL-APPLY 'vla-load (list (vla-get-Linetypes (vla-get-activedocument (vlax-get-acad-object))) "ByLayer" "acadiso.lin")))
(if (VL-CATCH-ALL-ERROR-P axErr) (setq axErr (VL-CATCH-ALL-APPLY 'vla-load (list (vla-get-Linetypes (vla-get-activedocument (vlax-get-acad-object))) "ByLayer" "EstateCADTools.lin"))))
(if (not (VL-CATCH-ALL-ERROR-P axErr)) (setvar "CeLtype" "ByLayer"))
(setvar "CeLTScale" 8.00000000)
(setvar "CeLweight" -1)
(ENTMAKE'((0 . "SPLINE")(100 . "AcDbEntity")(67 . 0)(8 . "0")(48 . 8.000000000000000)(100 . "AcDbSpline")(210 0.000000000000000 0.000000000000000 1.000000000000000)(70 . 12)(71 . 2)(72 . 30)(73 . 27)(74 . 0)(42 . 0.0000000010000000)(43 . 0.0000000001000000)(40 . 0.000000000000000)(40 . 0.000000000000000)(40 . 0.000000000000000)(40 . 1.000000000000000)(40 . 1.000000000000000)(40 . 2.000000000000000)(40 . 2.000000000000000)(40 . 3.000000000000000)(40 . 3.000000000000000)(40 . 4.000000000000000)(40 . 4.000000000000000)(40 . 5.000000000000000)(40 . 5.000000000000000)(40 . 6.278771812875807)(40 . 6.278771812875807)(40 . 7.278771812875806)(40 . 7.278771812875806)(40 . 8.557543625767296)(40 . 8.557543625767296)(40 . 9.557543625767296)(40 . 9.557543625767296)(40 . 10.55754362576729)(40 . 10.55754362576729)(40 . 11.55754362576729)(40 . 11.55754362576729)(40 . 12.55754362576730)(40 . 12.55754362576730)(40 . 13.55754362576729)(40 . 13.55754362576729)(40 . 13.55754362576729)(10 0.0155553835746105 -0.0052643917728117 0.000000000000000)(41 . 1.000000000000000)(10 0.0155250562627468 0.0061573329360090 0.000000000000000)(41 . 1.000000000000000)(10 0.0154947289508831 0.0175790576448296 0.000000000000000)(41 . 1.000000000000000)(10 -0.0000465675342787 0.0175377919203188 0.000000000000000)(41 . 1.000000000000000)(10 -0.0155878640194405 0.0174965261958080 0.000000000000000)(41 . 1.000000000000000)(10 -0.0155432559399488 0.0006964482319469 0.000000000000000)(41 . 1.000000000000000)(10 -0.0154986478604570 -0.0161036297319142 0.000000000000000)(41 . 1.000000000000000)(10 -0.0073884528882055 -0.0190778807718981 0.000000000000000)(41 . 1.000000000000000)(10 0.0007217420840460 -0.0220521318118820 0.000000000000000)(41 . 1.000000000000000)(10 0.0711689172896572 -0.0298436191898695 0.000000000000000)(41 . 1.000000000000000)(10 0.1416160924952683 -0.0376351065678569 0.000000000000000)(41 . 1.000000000000000)(10 0.1701230638911251 -0.0461223743165809 0.000000000000000)(41 . 0.8024623404975734)(10 0.1702020396998372 -0.0758658592304283 0.000000000000000)(41 . 1.000000000000000)(10 0.1705304440147311 -0.1995479073660651 0.000000000000000)(41 . 1.000000000000000)(10 0.1708588483618303 -0.3232299555016165 0.000000000000000)(41 . 1.000000000000000)(10 0.1709378242027548 -0.3529734404158654 0.000000000000000)(41 . 0.8024623404928947)(10 0.1424763257449687 -0.3616119725574273 0.000000000000000)(41 . 1.000000000000000)(10 0.0720715199786027 -0.3697774544375848 0.000000000000000)(41 . 1.000000000000000)(10 0.0016667142044611 -0.3779429362921238 0.000000000000000)(41 . 1.000000000000000)(10 -0.0064275718779832 -0.3809602139645178 0.000000000000000)(41 . 1.000000000000000)(10 -0.0145218579604275 -0.3839774916369119 0.000000000000000)(41 . 1.000000000000000)(10 -0.0144772498809358 -0.4007775696007730 0.000000000000000)(41 . 1.000000000000000)(10 -0.0144326418014440 -0.4175776475646340 0.000000000000000)(41 . 1.000000000000000)(10 0.0011086546837179 -0.4175363818401233 0.000000000000000)(41 . 1.000000000000000)(10 0.0166499511688797 -0.4174951161156127 0.000000000000000)(41 . 1.000000000000000)(10 0.0166196238570160 -0.4060733914067920 0.000000000000000)(41 . 1.000000000000000)(10 0.0165892965451524 -0.3946516666979714 0.000000000000000)(41 . 1.000000000000000)))
(setq obj1 (vlax-ename->vla-object (entlast)))
(if (not (or (= (vla-get-name obj) "*Model_Space") (WCMATCH (vla-get-name obj) "*Paper_Space*")))
(progn
(setq objary (vla-CopyObjects (vla-get-ActiveDocument (vlax-get-acad-object)) (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbObject (cons 0 0)) (list obj1))) obj))
(vla-delete obj1)
(setq obj1 (car (vlax-safearray->list (vlax-variant-value objary))))
) ;_ progn
) ;_ if
)
)
(setq obj (vla-get-ModelSpace(vla-get-ActiveDocument (vlax-get-acad-object))))
(vla-put-color (vla-item (vla-get-Layers (vla-get-activedocument (vlax-get-acad-object))) "0") "7")
(setvar "Clayer" "0")
(setvar "CeColor" "256")
(setq axErr (VL-CATCH-ALL-APPLY 'vla-load (list (vla-get-Linetypes (vla-get-activedocument (vlax-get-acad-object))) "ByLayer" "acadiso.lin")))
(if (VL-CATCH-ALL-ERROR-P axErr) (setq axErr (VL-CATCH-ALL-APPLY 'vla-load (list (vla-get-Linetypes (vla-get-activedocument (vlax-get-acad-object))) "ByLayer" "EstateCADTools.lin"))))
(if (not (VL-CATCH-ALL-ERROR-P axErr)) (setvar "CeLtype" "ByLayer"))
(setvar "CeLTScale" 1.00000000)
(setvar "CeLweight" -1)
(entmake (list '(0 . "INSERT") (cons 2 "yyy12345") (cons 10 insertpt)(cons 50 (+ (/ pi 2) jd) )))
;(setq obj1 (vla-InsertBlock obj (vlax-3d-point '(0.000000000000000 0.000000000000000 0.000000000000000)) "yyy12345" 1.00000000 1.00000000 1.00000000 1.57079633))
;(vla-put-layer obj1 "0")
;(command "move" (entlast) "" basept insertpt)
(mapcar 'setvar '("osmode" "cmdecho" "filedia") (list osmode cmdecho filedia))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun vxs (e / i v lst ppp)
(setq i 0)
(while
(setq v (vlax-curve-getpointatparam e (setq i (1+ i))))
(setq lst (cons v lst))
)
(setq ppp (reverse lst) )
(append (list(vlax-curve-getpointatparam e 0)) ppp )
)
;;;;;;;;;;;;;;;;;;;;;
(defun bm1005 (c ent / jb )
(setq jb (cdr (assoc 5 (entget c))))
(regapp "ZXCAD");必须先注册一个app的名字
(princ)
)
;;;;
(defun bm10051 (ent-text ent-line /OBJ text-objid txt-jb)
;(setq jb (cdr (assoc 5 (entget c))))
(regapp "ZXCAD");必须先注册一个app的名字
;两个图元绑定，支持复制粘贴，绑定关系依然不变，试试下面这个代码
;(setq ent-text(car(entsel "请点击一个文字")))
;(setq ent-line(car(entsel "请点击一根直线")))
(setq obj(vlax-ename->vla-object ent-text))
(setq text-objid(vla-get-objectid obj));文字的objid
(setq txt-jb(cdr(assoc 5(entget ent-text))));文字句柄
($zi-dian-xie-ru$ ent-line"ZXCAD" (list(cons 330 txt-jb))nil);将文字的id写入到直线里面，当用户复制图纸的时候，绑定关系依然成立
;(vlax-safearray->list(cdr(assoc 330(cdr(assoc "ZXCAD"($zi-dian-du-qu$ (CAR (entsel)) "ZXCAD"nil))))));读取看看
;(entget(cdr(assoc 330(cdr(assoc "ZXCAD"($zi-dian-du-qu$ (CAR (entsel)) "ZXCAD"nil))))));读取看看
;(entget(cdr(assoc 330(entget(car(entsel))))))
($zi-dian-xie-ru$ ent-line"ZXCAD" (list(cons 330 txt-jb))nil)
(princ)
)
;;;;;
(defun c:gbz11 ( / cc p1 plst zbb juli jiaodu i )
(vl-load-com)
(setq cc (car(entsel "\n 请选择坡顶线：")))
(bm10051 cc cc)
(setq plst (vxs cc) )
(setq p1 nil)
(setq zbb (mapcar'list plst (cdr plst)) )
(foreach x zbb
(setq juli (distance (car x) (cadr x)))
(setq jiaodu (angle (car x) (cadr x) ))
(MKEn001(car x) jiaodu )
;(bm1005 cc (entlast))
(bm10051 cc (entlast))
(setq i 0)
(repeat (fix ( / juli 0.8) )
(MKEn001 (polar (car x) jiaodu (* 0.8 (1+ i) ))jiaodu )
;(bm1005 cc (entlast))
(bm10051 cc (entlast))
(setq i (1+ i))
)
)
(princ)
)
;(MKEn001(getpoint)(angle (getpoint)(getpoint)))
; (cdr(assoc 1005(cdr(car(cdr(assoc -3 (entget(car(entsel))'("*"))))))))
;选择对象: "691"
(defun c:300xz( / cc ss sss i ent)
(setq cc (car(entsel "\n 请选择坡顶线：")))
(setq ss (ssget "x" '((0 . "insert")(2 . "yyy12345"))))
(setqi 0)(setq sss (ssadd))
(repeat(sslength ss)
(setq ent (ssname ss i))
(if(equal (vlax-safearray->list(cdr(assoc 330(cdr(assoc "ZXCAD"($zi-dian-du-qu$ ent "ZXCAD"nil))))))
(vlax-safearray->list(cdr(assoc 330(cdr(assoc "ZXCAD"($zi-dian-du-qu$ cc "ZXCAD"nil))))))
)
;(= (cdr(assoc 1005(cdr(car(cdr(assoc -3 (entget ent '("*")))))))) (cdr (assoc 5 (entget cc))) )
(ssaddent sss)
)
(setq i (1+ i))
) (SSSETFIRST nil sss)
(princ)
)
;;;;
(defun c:1005xz( / cc ss sss i ent)
(setq cc (car(entsel "\n 请选择坡顶线：")))
(setq ss (ssget "x" '((0 . "insert")(2 . "yyy12345"))))
(setqi 0)(setq sss (ssadd))
(repeat(sslength ss)
(setq ent (ssname ss i))
(if(= (cdr(assoc 1005(cdr(car(cdr(assoc -3 (entget ent '("*")))))))) (cdr (assoc 5 (entget cc))) )
(ssaddent sss)
)
(setq i (1+ i))
) (SSSETFIRST nil sss)
(princ)
)
本帖最后由 dcl1214 于 2025-6-6 21:52 编辑
(defun $objid>ent$ (objID / ent)
(if objID
(setq ent (vl-catch-all-apply
'vlax-vla-object->ename
(list
(vl-catch-all-apply
'vla-ObjectIdToObject
(list
(vla-get-activedocument (vlax-get-acad-object))
objID
)
)
)
)
)
)
(if (vl-catch-all-error-p ent)
(setq ent nil)
)
ent
) dcl1214 发表于 2025-6-2 10:06
(defun SetXrecord2 (txt zx name / dict satypes savalues vlaen vtobject vttypes vtvalues xrcd)
;(setq txt (car (entsel "\n点取文字:")))
;(setq zx (car (entsel "\n点取直线:")))
(setq vlaen (vlax-ename->vla-object txt))
(setq dict (vla-GetExtensionDictionary vlaen))
(setq saTypes (vlax-make-safearray vlax-vbInteger '(0 . 0)))
(vlax-safearray-fill saTypes (list 331))
(setq vtTypes (vlax-make-variant saTypes))
(setq saValues (vlax-make-safearray vlax-vbVariant '(0 . 0)))
(setq vtObject (vlax-make-variant (cdr (assoc 5 (entget zx)))))
(vlax-safearray-fill saValues (list vtObject))
(setq vtValues (vlax-make-variant saValues))
(setq xrcd (vla-AddXRecord dict name))
(vla-SetXRecordData xrcd vtTypes vtValues)
)
;(setq e1 (get-dict-ename-entget (car (entsel "\n点取文字")) "00"))
(defun get-dict-ename-entget (txt key / en xrec-ent xrec-handle xx);
(setq en (cdr (assoc 360 (entget txt))))
(setq xrec-handle (cdr (assoc -1 (dictsearch en key))))
(setq xrec-ent (entget xrec-handle))
(setq xx (cdr (assoc 331 xrec-ent))) ; 返回ENAME
)
这样写应该也能达到目的 强哥这么厉害吗，大佬你厉害还是强哥厉害. 大佬介绍下怎么使用呀 增 删 读 ，改？ 本帖最后由 dcl1214 于 2025-6-6 21:51 编辑
两个图元绑定，支持复制粘贴，绑定关系依然不变，试试下面这个代码
(setq ent-text(car(entsel "请点击一个文字")))
(setq ent-line(car(entsel "请点击一根直线")))
(setq obj(vlax-ename->vla-object ent-text))
(setq text-objid(vla-get-objectid obj));文字的objid
(setq txt-jb(cdr(assoc 5(entget ent-text))));文字句柄
($zi-dian-xie-ru$ ent-line"ZXCAD" (list(cons 330 txt-jb))nil);将文字的id写入到直线里面，当用户复制图纸的时候，绑定关系依然成立
(cdr(assoc 330(cdr(assoc "ZXCAD"($zi-dian-du-qu$ (CAR (entsel)) "ZXCAD"nil)))));读取看看
大佬介绍下运用场景~ dcl1214 发表于 2025-6-1 23:58
(cdr(assoc 330(cdr(assoc "ZXCAD"($zi-dian-du-qu$ (CAR (entsel)) "ZXCAD"nil)))));读取看看
读取了,是个安全数组.vlax-safearray->list 解析了是个表.如何返回实体的objectID啊. 有错误~~~~~
就这么完事调试了可以啊
页:
[1]
2