玖叶教程网

前端编程开发入门

AutoCAD二次开技术之AutoLISP(11)

2.12.5 访问和修改扩展数据(示例)

(defun c:dk(/ code d data dcl_re dclname en ent f gr i ii iii iiii inf key keylst keylst2 kzsj loop lst1 lst2 lw n name nent oldent pd pt ptlst ss str str1 txlst w ww x y zuma);<扩展数据编辑>

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun *error* (inf) ; 重定义出错处理函数

(setq inf (strcase inf t))

(if (wcmatch inf "*break*,*cancel*,*exit*,*取消*,*中断*")

(deltx txlst)

)

(vla-endundomark (vla-get-activedocument (vlax-get-acad-object)));(vlax-get-acad-object) 返回一个指向AutoCAD应用程序对象的指针

;(vla-get-activedocument acadObject) 返回应用程序对象中当前文档

  ;(vla-endundomark acadDocument) 结束当前文档块标记操作

(princ)

)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun jspt (pt w ww) ; pt相对坐标计算

(list (+ (car pt) w) (+ (cadr pt) ww))

)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun dxf (ent n) ; 取得图元内容

(if (= (type ent) 'ename) ;如果ent是图元名,则将把图元的联结表赋给它

(setq ent (entget ent))

)

(cdr (assoc n ent)) ;取得n的Dxf组码值

)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun emod (ent i n) ; 替换图元内容,ent是图元联结表项,i是dxf组码,n是对应的内容

(subst

 (cons i n) ;i与n组成点对

 (assoc i ent) ;提取i对应的图元的原来要替换的表项

  ent

)

)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun deltx (txlst / en i x)  ;删除显示的txlst='(ename0 ename1 ...)

(foreach x txlst

(entdel x)

)

(setq w 0.0)

(if lw

(progn

(setq en (entget lw)

en (reent en (list '(0.0 0.0) '(0.0 0.0)))

)

(entmod (emod en 43 0.0))

)

)

(if oldent

(redraw oldent 4)

)

)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun wrxdata (name lst / lst1 x) ; 写入扩展数据1

(dedata name)

(setq lst2 '())

(foreach y lst

(setq lst1 '())

(foreach x y

(cond ((= 1000 (setq zuma (atoi (get_attr x "label"))))(setq lst1 (append lst1 (list(cons zuma (get_tile x))))))

((= 1001 (setq zuma (atoi (get_attr x "label"))))(setq lst1 (append lst1 (list(cons zuma (get_tile x))))))

((= 1002 (setq zuma (atoi (get_attr x "label"))))(setq lst1 (append lst1 (list(cons zuma (get_tile x))))))

((= 1003 (setq zuma (atoi (get_attr x "label"))))(setq lst1 (append lst1 (list(cons zuma (get_tile x))))))

((= 1004 (setq zuma (atoi (get_attr x "label"))))(setq lst1 (append lst1 (list(cons zuma (get_tile x))))))

((= 1005 (setq zuma (atoi (get_attr x "label"))))(setq lst1 (append lst1 (list(cons zuma (get_tile x))))))

((= 1010 (setq zuma (atoi (get_attr x "label"))))(setq lst1 (append lst1 (list(cons zuma (strtolst (get_tile x)))))))

((= 1020 (setq zuma (atoi (get_attr x "label"))))(setq lst1 (append lst1 (list(cons zuma (strtolst (get_tile x)))))))

((= 1030 (setq zuma (atoi (get_attr x "label"))))(setq lst1 (append lst1 (list(cons zuma (strtolst (get_tile x)))))))

((= 1011 (setq zuma (atoi (get_attr x "label"))))(setq lst1 (append lst1 (list(cons zuma (strtolst (get_tile x)))))))

((= 1021 (setq zuma (atoi (get_attr x "label"))))(setq lst1 (append lst1 (list(cons zuma (strtolst (get_tile x)))))))

((= 1031 (setq zuma (atoi (get_attr x "label"))))(setq lst1 (append lst1 (list(cons zuma (strtolst (get_tile x)))))))

((= 1012 (setq zuma (atoi (get_attr x "label"))))(setq lst1 (append lst1 (list(cons zuma (strtolst (get_tile x)))))))

((= 1022 (setq zuma (atoi (get_attr x "label"))))(setq lst1 (append lst1 (list(cons zuma (strtolst (get_tile x)))))))

((= 1032 (setq zuma (atoi (get_attr x "label"))))(setq lst1 (append lst1 (list(cons zuma (strtolst (get_tile x)))))))

((= 1013 (setq zuma (atoi (get_attr x "label"))))(setq lst1 (append lst1 (list(cons zuma (strtolst (get_tile x)))))))

((= 1023 (setq zuma (atoi (get_attr x "label"))))(setq lst1 (append lst1 (list(cons zuma (strtolst (get_tile x)))))))

((= 1033 (setq zuma (atoi (get_attr x "label"))))(setq lst1 (append lst1 (list(cons zuma (strtolst (get_tile x)))))))

((= 1040 (setq zuma (atoi (get_attr x "label"))))(setq lst1 (append lst1 (list(cons zuma (atof (get_tile x)))))))

((= 1041 (setq zuma (atoi (get_attr x "label"))))(setq lst1 (append lst1 (list(cons zuma (atof (get_tile x)))))))

((= 1042 (setq zuma (atoi (get_attr x "label"))))(setq lst1 (append lst1 (list(cons zuma (atof (get_tile x)))))))

((= 1070 (setq zuma (atoi (get_attr x "label"))))(setq lst1 (append lst1 (list(cons zuma (atoi (get_tile x)))))))

((= 1071 (setq zuma (atoi (get_attr x "label"))))(setq lst1 (append lst1 (list(cons zuma (atoi (get_tile x)))))))

((wcmatch (setq zuma (get_attr x "label")) "程序名:")(setq lst1 (cons (get_tile x) lst1)))

)

)

(setq lst2 (append lst2 (list lst1)))

)

(entmod (append

(entget name)

(list (cons -3 lst2)))

)

)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun dedata (name) ; 删除扩展数据

(entmod (list (cons -1 name)

(cons -3 (mapcar 'list (mapcar 'car (cdr (assoc -3 (entget name '("*")) ) ) ) ))

)

)

)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun lsttostr (lst / n str) ; 表转字符串

(setq str "")

(foreach n lst

(setq str (strcat str (if (= (type n) 'STR) n (rtos n 2 3)) " "))

)

str

)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun strtolst (str / i lst str1) ; 字符串转表

(setq lst '()

i 1

)

(while (/= str "")

(if (= (substr str i 1) " ")

(setq str1 (substr str 1 (1- i))

lst (cons (atof str1) lst)

str (substr str (1+ i))

i 1

)

(setq i (1+ i))

)

)

(reverse lst)

)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun reent (ent ptlst / i nent x) ; 按点表顺序更新多段线顶点,无须更换的顶点用nil代替。返回nent最后的值

(setq i -1

nent '( )

)

(foreach x ent

(setq nent (append nent (list (if (and (= (car x) 10) (/= (nth (setq i (1+ i)) ptlst ) nil ) )

(cons 10 (nth i ptlst))

x

)

)

)

)

)

)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

发表评论:

控制面板
您好,欢迎到访网站!
  查看权限
网站分类
最新留言