entmake如何插入属性块?
如题,目前我暂时用的是(command "-Insert" "blkname" p0 1 1 0 (nth 0 lst2)(nth 1 lst2)(nth 2 lst2)(nth 3 lst2)(nth 4 lst2)(nth 5 lst2)(nth 6 lst2)(nth 7 lst2))
我想知道entmake如何插入这种属性块?
blkname块名
p0插入位置
1 1 0x比例 y比例 角度
(nth 0 lst2)(nth 1 lst2)(nth 2 lst2)(nth 3 lst2)(nth 4 lst2)(nth 5 lst2)(nth 6 lst2)(nth 7 lst2)属性块的8个属性~
本帖最后由 飞雪神光 于 2024-1-6 20:59 编辑
坠茵落溷 发表于 2024-1-6 19:36
楼主这个问题解决了吗?
(setvar "attreq" 0)正常情况下可以先插入 然后设置属性 恢复 (setvar "attreq" 1) wmz 发表于 2014-9-25 21:25
;;;测试
(defun c:tt()
(setq ent (car (entsel "\n请选择块: ")))
是可以的,'("height" . "33.56")-->(list '("height" . "33.56")) 本帖最后由 77077 于 2014-7-20 15:37 编辑
Entmake 插入块测试
(Entmake (List
'(0 . "Insert")
'(100 . "Acdbentity")
'(100 . "Acdbblockreference")
'(66 . 0)
(Cons 2 "kzzb1")
(Cons 10 (getpoint))
(Cons 8 "layer1")
(Cons 41 1) ;Scale比例大小
(Cons 42 1) ;Scale比例大小
(Cons 43 1) ;Scale比例大小
)
)
能插入,但是没填写属性~~~ elsbox里面有块的生成,可以去研究下 块生产这个已经回了,现在请教的是,用entmake方式插入属性块
http://fushouyin.blog.163.com/blog/static/1889871920091784537819/
练习 修改属性块的属性值.lsp
;;;=================================================================* ;;; 通用函数 * ;;;功能:获取属性块中全部的属性名称 * ;;;参数: EN -----包含属性的块的图元名称 * ;;;返回:返回属性名称列表。 * ;;;日期:zml84 于 2009-09-19 * (defun ZL-INSERT-GETattname (EN / lst E TEST ENt attname) (setq lst '() E EN TEST t ) (while (and TEST (setq E (entnext E)) )(setq ENT (entget E))(cond ;; ((not (= (cdr (assoc 0 ENT)) "ATTRIB")) (setq TEST NIL) ) ;; ((= "SEQEND" (cdr (assoc 0 ENT))) (setq TEST NIL) ) ;; (t (setq attname (cdr (assoc 2 ENT)) lst (cons attname lst) ) )) ;_结束cond ) ;;返回 lst ) ;;;=================================================================* ;;; 通用函数 * ;;;功能:属性块中属性值的获取 * ;;;参数: EN -----包含属性的块的图元名称 * ;;; AttName -----属性名称 * ;;;返回:成功则返回结果;否则返回nil * ;;;日期:zml84 于 2009-08-11 * (defun ZL-INSERT-gETATTVALUE (EN ATTNAME/ RETURN E TEST ENT) (setq E EN RETURN NIL TEST t ) (while (and TEST (setq E (entnext E)) )(setq ENT (entget E))(cond ;; ((not (= (cdr (assoc 0 ENT)) "ATTRIB")) (setq TEST NIL) ) ;; ((= "SEQEND" (cdr (assoc 0 ENT))) (setq TEST NIL) ) ;; ((= (cdr (assoc 2 ENT)) ATTNAME) (setq RETURN (cdr (assoc 1 ENT))) (setq TEST NIL) )) ;_结束cond ) ;;返回 RETURN );;;=================================================================* ;;; 通用函数 * ;;;功能:属性块中属性值的修改 * ;;;参数: EN -----包含属性的块的图元名称 * ;;; AttName -----属性名称 * ;;; Value -----修改为的值 * ;;;返回:T表示修改成功;否则返回nil * ;;;日期:zml84 于 2009-02-05 * (defun ZL-INSERT-SETATTVALUE (EN ATTNAME VALUE / RETURN E TEST ENT) (setq E EN RETURN NIL TEST t ) (while (and TEST (setq E (entnext E)) )(setq ENT (entget E))(cond ;; ((not (= (cdr (assoc 0 ENT)) "ATTRIB")) (setq TEST NIL) ) ;; ((= "SEQEND" (cdr (assoc 0 ENT))) (setq TEST NIL) ) ;; ((= (cdr (assoc 2 ENT)) ATTNAME) (setq ENT (subst (cons 1 VALUE) (assoc 1 ENT) ENT ) ) (entmod ENT) (entupd EN) (setq RETURN t) )) ;_结束cond ) ;;返回 RETURN );;;=============================================* ;;;测试 * ;;; * (defun C:TT (/ SS) (if (setq SS (entsel "\n点取要修改的属性块: "))(princ (ZML-INSERT-SETATTVALUE (car SS) "height" "123456789")) ) (princ) ) ;;;=============================================* 你真美理解我要什么东西~~~ 前段时间试了一下复制属性块,工作忙没来得及更多测试,看一下下面的一堆英文字母是否对你有用,当前是将属性块往上复制70mm;
(defun c:xx ( )
(setq ent(car (entsel)))
(setq et(entget ent))
(setq pt(cdr (assoc 10 Et)))
(mapcar '(lambda(x);;匿名函数
(setq et(vl-remove(assoc x et)et))
)
'(-1 330 5 100 67100 6170 71 )
)
(setq ss (entnext ent))
(SETQ PT2(CONS 10(POLAR PT (/ PI 2) 70)))
(SETQ ET2(SUBST PT2 (assoc 10 Et) ET))
(entmake et2)
(attblockinfo SS PT)
)
(defun attblockinfo ( ss pt / )
(setq elist(entget ss))
(while
(/= (cdr (assoc 0 elist)) "SEQEND")
;(setq pt(cdr(assoc 10 elist)))
(setq pts(cdr(assoc 11 elist)))
;(SETQ PT2(CONS 10(POLAR PT (/ PI 2) 70)))
(SETQ PT2s(CONS 11(POLAR PTs (/ PI 2) 70)))
;(setq elist(substpt2 (assoc 10 elist) ELIST))
(setq elist(substpt2s (assoc 11 elist) ELIST))
(entmake elist)
(setq ss(entnext ss))
(setq elist(entget ss))
)
(entmake (list (cons 0 "SEQEND")))
(prin1)) 没有找到方法,急等待! ;;;测试
(defun c:tt()
(setq ent (car (entsel "\n请选择块: ")))
(VxSetAtts (vlax-ename->vla-object ent) '("height" . "33.56"))
)
;;;设置块中属性 (从学习手册中抄来)
(defun VxSetAtts (Obj Lst / AttVal)
(mapcar
'(lambda (Att)
(if (setq AttVal (cdr (assoc (vla-get-TagString Att) Lst)))
(vla-put-TextString Att AttVal)
)
)
(vlax-invoke Obj "GetAttributes")
)
(vla-update Obj)
(princ)
)
;;;测试不成功!!! 请教:你这是如何插入的属性块呢?
页:
[1]
2