|
|
我的一个程序，原意是点击一个图框然后图框里的各种比例都相应于图框比例变化（图框的外框用封闭的polyline绘制，然后再作成块，需要时只是scale一下，通过函数可以获得放大比例）。但是我发现用endmake建立dimstyle时，不能建立标注文字样式和箭头样式，总是用standard文字样式代替，不知道怎么解决！！所以写不下去了。 下面是我的code,请帮助！可以试用
;点图框修改图框内的各种比例
;（a3图框按1:1画出，并且内框用闭和pl画出，然后做成块）
;以便取出四个角点
(Defun c:#ss ()
;------sub function:列出符号"block"的表.----------------
(defun block_list (elist)
(setq dict_block_name (cdr(assoc 2 elist))
dict_block_list (tblsearch "block" dict_block_name)
dict_block_xobject(cdr (assoc -2 dict_block_list))
block_xlist '()
)
(while (setq block_xlist (cons (entget dict_block_xobject) block_xlist)
dict_block_xobject (entnext dict_block_xobject)
)
)
)
;-----sub function:修改标注比例--------
(defun dim_style (c_scale)
(setq dim_sj '((0 . "DIMSTYLE") (100 . "AcDbSymbolTableRecord")
(100 . "AcDbDimStyleTableRecord")
(2 . "$1") (70 . 0)(40 . 1.0) (41 . 1.5)
(42 . 1.0) (43 . 1.0) (44 . 1.0) (73 . 0)
(74 . 0) (77 . 1)(78 . 8) (140 . 2.5) (141 . 0.0)
(147 . 1.0) (176 . 1) (177 . 1) (178 . 2)
(271 . 1) (272 . 1) (279 . 2) (284 . 8))
)
(entmake dim_sj)
(if (>= (- c_scale (fix c_scale)) 0.5)
(setq c_sc(itoa (1+ (fix c_scale))))
(setq c_sc (itoa (fix c_scale)))
)
(setq dim_sj (subst (cons 2 (strcat "$" c_sc)) (assoc 2 dim_sj) dim_sj))
(setq dim_sj (subst (cons 40 (read c_sc)) (assoc 40 dim_sj) dim_sj))
(entmake dim_sj)
(command "-dimstyle" "r" (strcat "$" c_sc)) ;上边也有问题：建立了新标注 后不 能让它成为当前注
;必须要用上面那句话来让它成为当前标注
(command "-dimstyle" "a" "wp" p0 p1 p2 p3 "" "")
)
;----------main function----------------------------------
(while(not(setq entname(car (entsel ":请选择图框:"))))
(princ "\n图框不是块!从新选择.")
)
(setq entlist (entget entname '("*"))
)
(setq c_scale (cdr (assoc 41 entlist))
c_to_ucs (trans (cdr (assoc 10 entlist) ) 0 1)
)
(block_list entlist)
(setq block_xlist (reverse block_xlist))
(type (car block_xlist))
(setq len_th (length block_xlist)
list1 '()
)
(repeat len_th
(if(and
(vl-position '(0 . "LWPOLYLINE") (nth 0 block_xlist))
(vl-position '(70 . 1) (nth 0 block_xlist))
)
(setq list1 (cons (nth 0 block_xlist) list1 )
block_xlist (vl-remove (nth 0 block_xlist) block_xlist))
(setq block_xlist (vl-remove (nth 0 block_xlist) block_xlist))
)
)
(setq list1 (car list1)
counter 0
p_list '()
)
(while (setq bb (nth counter list1))
(if (= (car bb) 10)
(setq point (nth counter list1)
p_list (cons point p_list)
counter (1+ counter)
)
(setq counter (1+ counter))
)
)
;;;-很奇怪，如果放大插入块，reference-block 的数据结构中符号表中的数据(lwploylien的连接点点位居然不变，
;;;只好把ocs的点坐标乘以当前块的比例系数(c_scale)再加上ucs下的插入点坐标(经trans函数处理),以得到图的
;;;四个角点.
(setq dp(cdr(nth 0 p_list))
p0 (mapcar '+ (mapcar '* (list c_scale c_scale c_scale)
(reverse(cons '0.0 (reverse dp)))) c_to_ucs))
(setq dp(cdr(nth 1 p_list))
p1 (mapcar '+ (mapcar '* (list c_scale c_scale c_scale)
(reverse(cons '0.0 (reverse dp)))) c_to_ucs))
(setq dp(cdr(nth 2 p_list))
p2 (mapcar '+ (mapcar '* (list c_scale c_scale c_scale)
(reverse(cons '0.0 (reverse dp)))) c_to_ucs))
(setq dp(cdr(nth 3 p_list))
p3 (mapcar '+ (mapcar '* (list c_scale c_scale c_scale)
(reverse(cons '0.0 (reverse dp)))) c_to_ucs))
(setq p_l(list p0 p1 p2 p3))
(setq ss_get (ssget "wp" p_l))
(dim_style c_scale)
)
|
|
置顶卡
