刚写的一个小程序发现有问题，请大神帮助
源程序如下功能是把选择放入0-建筑底图中
(defun c:0T()
(setq ceng "0-建筑底图")
(PRINC "\n---将所选对象设置为")(princ ceng)(PRINC "，属性随层")
(if (= (TBLOBJNAME "LAYER" ceng) nil)
(command "layer" "n" ceng "c" "8" ceng "lt" "" "bylayer" ""))
(while(setq a (ssget":s"))
(setvar "cmdecho" 0)
(command "change" a "" "p" "c" "bylayer" "la" ceng "lw" "bylayer" "")
)
(command "clayer" ceng)
(PRINC "\n---将所选对象设置为")(princ ceng)(PRINC "，属性随层")
(princ)
)
发现问题，如果某层已经设置线型，并在图中linetype 为bylayer情况下， 切换到0-建筑底图 层中，原有线型就会消失
希望大神改进
思路
(defun c:0T()
(setq ceng "0-建筑底图")
(PRINC "\n---将所选对象设置为")(princ ceng)(PRINC "，属性随层")
(if (= (TBLOBJNAME "LAYER" ceng) nil)
(command "layer" "n" ceng "c" "8" ceng "lt" "" "bylayer" ""))
(while(setq a (ssget":s"))
(setvar "cmdecho" 0)
判断物体所在图层是否已经设置非continue的线型，如果是
将物体linetype转换为图层所设置的线型
(command "change" a "" "p" "c" "bylayer" "la" ceng "lw" "bylayer" "")
)
(command "clayer" ceng)
(PRINC "\n---将所选对象设置为")(princ ceng)(PRINC "，属性随层")
(princ)
)
跪求大神完善或者提供更好的源码
(defun c:0T (/ ceng ss en dxf lt)
(setvar "cmdecho" 0)
(setq ceng "0-建筑底图")
(princ (strcat "\n---将所选对象设置为" ceng "，属性随层"))
(if (not (tblsearch "layer" ceng))
(command "_layer" "m" ceng "c" "8" ceng "lt" "Continuous" ceng "")
(command "layer" "s" ceng "c" "8" "" "lt" "Continuous" ceng "")
)
(while (setq ss (ssget ":s"))
(repeat (setq n (sslength ss))
(setq en (ssname ss (setq n (1- n))))
(setq dxf (entget en))
(if (not (cdr (assoc 6 dxf)))
(progn
(setq lt (cdr (assoc 6 (entget (tblobjname "layer" (cdr (assoc 8 dxf)))))))
(command "chprop" en "" "la" ceng "lw" "ByLayer" "lt" lt "")
)
(command "chprop" en "" "la" ceng "lw" "ByLayer" "")
)
)
)
(princ (strcat "\n---将所选对象设置为" ceng "，属性随层"))
(setvar "cmdecho" 1)
(princ)
) 那就在改层以前，先把原来随层的线型信息提取出来，在放到0-建筑底图中后，再把它恢复到原来线型不就行了 哥，我是初学者，麻烦直接上代码，谢谢 ;;;command太差了，给你整了一段，全部费掉command
;;;师兄 QQ 361865648
(defun c:0T (/ ceng ss ent i entdat layername layent laydat ltyp lwidth
obj)
(setq ceng "0-建筑底图")
(if (= (TBLOBJNAME "LAYER" ceng) nil)
(entmakex '(
'(0 . "LAYER")
'(100 . "AcDbSymbolTableRecord")
'(100 . "AcDbLayerTableRecord")
(cons 2 ceng)
'(70 . 0)
'(62 . 7)
'(6 . "Continuous")
)
)
;;;旧代码 (command "layer" "n" ceng "c" "8" ceng "lt" "" "bylayer" "")
)
;;; (setvar "cmdecho" 0)
(entget (tblobjname "layer" "0"))
(while (and (setq ss (VL-CATCH-ALL-APPLY 'ssget (list ":S")))
ss
(not (VL-CATCH-ALL-ERROR-P ss))
)
;;; (setvar "cmdecho" 0)
(PRINC "\n---将所选对象设置为")
(princ ceng)
(PRINC "，属性随层")
(setq i 0)
(repeat (sslength ss) ;_遍历选择集
(setq ent (ssname ss i)
i (1+ i)
entdat (entget ent)
layername (cdr (assoc 8 entdat)) ;_层名
layent (tblobjname "layer" layername)
laydat (entget layent)
ltyp (cdr (assoc 6 laydat)) ;_线型
Lwidth (cdr (assoc 370 laydat)) ;_线宽
color (cdr (assoc 62 laydat)) ;_颜色
)
(setq obj (vlax-ename->vla-object ent))
(vla-put-color obj acbylayer) ;_颜色为随层
(vla-put-LineWeight obj acLnWtByLayer) ;_线宽为随层
;;; (vla-put-linetype obj "bylayer");_线型为随层
(if (= (vla-get-linetype obj) "bylayer")
(vla-put-linetype obj ltyp) ;_线型固定
)
;;; (if (= (vla-get-lineweight obj) acLnWtByLayer)
;;; (vla-put-LineWeight obj Lwidth) ;_线宽固定
;;; )
;;; (if (= (vla-get-color obj) acbylayer)
;;; (vla-put-color obj color) ;_颜色固定
;;; )
(vla-put-layer obj ceng)
(vlax-release-object obj)
)
;;; 改前(command "change" a "" "p" "c" "bylayer" "la" ceng "lw" "bylayer" "")
)
;;;(command "clayer" ceng)
(setvar "clayer" ceng)
;;; (PRINC "\n---将所选对象设置为 ")
;;; (princ ceng)
;;; (PRINC " ，属性随层")
(princ)
)
本帖最后由 tranney 于 2014-4-13 00:06 编辑
谢谢5楼给的代码，基本上快要达到效果了，增加了一句代码，最后效果见附图
(defun c:0T (/ ceng ss en dxf lt)
(setvar "cmdecho" 0)
(setq ceng "0-建筑底图")
(princ (strcat "\n---将所选对象设置为" ceng "，属性随层"))
(if (not (tblsearch "layer" ceng))
(command "_layer" "m" ceng "c" "8" ceng "lt" "Continuous" ceng "")
(command "layer" "s" ceng "c" "8" "" "lt" "Continuous" ceng "")
)
(while (setq ss (ssget ":s"))
(repeat (setq n (sslength ss))
(setq en (ssname ss (setq n (1- n))))
(setq dxf (entget en))
(if (not (cdr (assoc 6 dxf)))
(progn
(setq lt (cdr (assoc 6 (entget (tblobjname "layer" (cdr (assoc 8 dxf)))))))
(command "chprop" en "" "la" ceng "lw" "ByLayer" "lt" lt "")
)
(command "chprop" en "" "la" ceng "lw" "ByLayer" "")
)
)
(command "change" a "" "p" "c" "bylayer" "la" ceng "lw" "bylayer" "");*增加本行代码后已达到要求
)
(princ (strcat "\n---将所选对象设置为" ceng "，属性随层"))
(setvar "cmdecho" 1)
(princ)
)
本帖最后由 caiqs 于 2014-4-13 22:25 编辑
tranney 发表于 2014-4-13 00:03 static/image/common/back.gif
谢谢5楼给的代码，基本上快要达到效果了，增加了一句代码，最后效果见附图
(defun c:0T (/ ceng ss en dxf ...
你难道要的不是颜色和线宽随层，线型不随新层？ 线型随新层不好，比如以前的中心线，虚线就都看不出来了 caiqs 发表于 2014-4-12 21:29 static/image/common/back.gif
;;;command太差了，给你整了一段，全部费掉command
;;;师兄 QQ 361865648
如果针对图块呢？ 特别是嵌套块
页:
[1]