帮忙写个程序
本帖最后由 cjjh8301 于 2011-5-3 11:34 编辑帮忙写个程序,能实现根据自定义命令将线或其他实体归到指定的图层,并且颜色,线的粗细,线性都随层,如果没有该层,则自动创建该层。比如
在某层预选一条白实线,命令C1后,此线归到S1层,颜色变为红色、线型变为虚线,如果找不到S1层,则创建S1层颜色为红、线型为虚线并将此线和上面一样归到S1层
以此类推能自定义命令C2、C3。。。。 对应图层S2、S3。。。。
本帖最后由 Andyhon 于 2011-5-2 11:40 编辑
;;; 且试如下 , 若符所需 , 请依此衍生
(defun C:c1 ()
(cond
((setq ss (cadr (ssgetfirst))) ; 某层预选
(if (tblsearch "Layer" "S1") nil
(command "Layer" "make"
"S1"
"C"
"1" ; color
""
"L"
"H" ; linetype
""
""
))
(command "chprop" ss "" "La" "S1" "C" "bylayer" "Lt" "bylayer" "")
))
)
程序可用,就是添加更多命令时要修改的地方有点多,下面红色的都要和图层对应起来,不知能否简化?在此忠心感谢这位前辈!
(defun C:c1 ()
(cond
((setq ss (cadr (ssgetfirst))) ; 某层预选
(if (tblsearch "Layer" "S1") nil
(command "Layer" "make"
"S1"
"C"
"1" ; color
""
"L"
"H" ; linetype
""
""
))
(command "chprop" ss "" "La" "S1" "C" "bylayer" "Lt" "bylayer" "")
))
)
(defun Ccl (la c lt)
(if (tblsearch "Layer" la) nil
(command "Layer" "make"
la
"C"
c ; color
""
"L"
lt ; linetype
""
""
))
(command "chprop" ss "" "La" la "C" "bylayer" "Lt" "bylayer" "")
)
(defun C:c1 ()
(if (setq ss (cadr (ssgetfirst))) ; 某层预选
(Ccl "S1" "1" "H") ; 对应变量
)
)
甚或 某层预选 也交付副函式处理
(if (not (tblobjname "layer" "p3"));如果不存在p3层.新生成
(entmake
(list '(0 . "LAYER") ;_类型名称
'(100 . "AcDbSymbolTableRecord") ;
'(100 . "AcDbLayerTableRecord") ;
(cons 2 "p3") ;新层名
'(70 . 0)
(cons 62 71) ;cons 62 +颜色代码
(cons 6 "CONTINUOUS") ;线型设置
)
)
)
;---------------------------------- 我如下设置了5个图层,怎么只能使用一次,第二次输入命令就没用了请前辈指教
(defun Ccl (la c lt)
(if (tblsearch "Layer" la) nil
(command "Layer" "make"
la
"C"
c ; color
""
"L"
lt ; linetype
""
""
))
(command "chprop" ss "" "La" la "C" "bylayer" "Lt" "bylayer" "")
)
(defun C:l1 ()
(if (setq ss (cadr (ssgetfirst))) ; 某层预选
(Ccl "s1" "5" "continuous") ; 对应变量
)
)
(defun C:l2 ()
(if (setq ss (cadr (ssgetfirst))) ;
(Ccl "s2" "50" "hidden") ;
)
)
(defun C:l3 ()
(if (setq ss (cadr (ssgetfirst))) ;
(Ccl "s3" "30" "continuous") ;
)
)
(defun C:l4 ()
(if (setq ss (cadr (ssgetfirst))) ;
(Ccl "s4" "3" "continuous") ;
)
)
(defun C:l5 ()
(if (setq ss (cadr (ssgetfirst))) ;
(Ccl "s5" "2" "continuous") ;
)
) 第二次输入命令就没用了?
'某层预选' 可有
没了对象就不作用了
(defun C:l1 ()
(if (setq ss (cadr (ssgetfirst))) ; 某层预选
(Ccl "s1" "5" "continuous") ; 对应变量
(alert "请确认 已预选对象!")
)
) 恩恩可以用了,这样画图就方便多了,比MA 刷快多了,多谢!
顺便问下 这个悬赏是怎么意思,怎么把币给出去,一直是未解决?? 不好意思又不行了,发现第一次用时可以的,每个命令用了一次 ,S1-到S5图层都存在后,再用这些命令就不行了,或者图纸中原来就有S1到S5这几个图层,那么加载了程序后就一次也用不了。 我这儿 只要有 '预选' 都成功
请上传该文件(*.dwg) 以利调试
页:
[1]
2