点取对象,根据颜色加粗所有对象------终于完成
本帖最后由 /db_自贡黄明儒_ 于 2013-7-30 08:17 编辑按理说,绘图我们不需要指定对象宽度,CAD打印时有一个简单的办法,指定颜色的宽度来指印。
我看见设计院的图,估计是他们偷懒,只画主要轮廓线,而且画得很粗,看起来也象模象样的。
;;*****************根据颜色,来加宽线 自贡黄明儒 2013年7月24日
;;特此鸣谢mccad wowan1314 ll_j
(defun C:HHBC (/ COLOR EN FIL LAYLIS LEN PEDITVAR SS0 SSCIR SSLIN)
;;(setvar "CLAYER" "0")
;;1 Public1 分离选择集
;;SSCIR SSLIN
(defun getMyss (ss0)
(command "_.select" ss0 "")
(setq ssCIR (ssget "_p" (list (cons 0 "CIRCLE"))))
(command "_.select" ss0 "")
(setq ssLIN (ssget "_p"
(list (cons 0 "ARC,LINE,LWPOLYLINE"))
)
)
)
;;2 Public2 处理圆选择集
(defun cirSS (ssCIR LEN color / CENTER EN ENTLIST N R)
(if ssCIR
(repeat (setq n (sslength ssCIR))
(setq en (ssname ssCIR (setq n (1- n))))
(setq entlist (entget en))
(setq r (* (cdr (assoc 40 entlist)) 2))
(setq center (cdr (assoc 10 entlist)))
(command "_.donut" (- r len) (+ r len) center "")
(vlax-put (vlax-ename->vla-object (entlast)) 'color color)
(command "_.erase" en "")
)
)
)
;;3 Public3 处理线选择集
(defun LineSS (SSLIN len)
(SETQ PEDITVAR (GETVAR "PEDITACCEPT"))
(setvar "PEDITACCEPT" 1)
(if SSLIN
(command "_.pedit" "_M" ssLIN "" "_j" "" "w" len "")
)
(setvar "PEDITACCEPT" PEDITVAR)
)
;;4 获取颜色
;;color EN
(defun getcolor (/ ENTLIST LAYER)
(while (not en) (setq en (car (entsel "\n 点取颜色"))))
(setq entlist (entget en))
(if (setq color (cdr (assoc 62 entlist)))
nil
(progn
(setq layer (cdr (assoc 8 entlist)))
(setq color (cdr (assoc 62 (tblsearch "layer" layer))))
)
)
)
;;5 预设线宽
(defun PreWidth (en / CENTER ENLAST ENTLIST LEN LEN1 LI R)
(setq entlist (entget en))
(if (member (setq li (cdr (assoc 0 entlist)))
(list "ARC" "LINE" "CIRCLE" "LWPOLYLINE")
)
(progn
(setq len (vlax-curve-getDistAtParam en (vlax-curve-getEndParam en)))
(setq len (/ len 100))
(cond ((= li "CIRCLE")
(setq r (* (cdr (assoc 40 entlist)) 2))
(setq center (cdr (assoc 10 entlist)))
(command "donut" (- r len) (+ r len) center "")
(setq enlast (entlast))
)
((= li "LWPOLYLINE") (command "_.PEDIT" en "W" len ""))
(T
(if (= (atof (getvar "acadver")) 16.1)
(command "_.PEDIT" en "Y" "W" len "")
;昨天测试不加Y,今天测还是要加Y(7月25日)
(command "_.PEDIT" en "Y" "W" len "")
)
)
)
(princ "\n 当前线宽是 ")
(princ len)
(initget (+ 2 4))
(setq len1 (getreal (strcat "\n 输入线宽<" (rtos len 2 3) ">")))
(if len1
(progn (setq len len1)
(if enlast
(command "_.erase" enlast "")
)
)
)
)
(progn (princ "\n 默认线宽") (princ (setq len 2.0)))
)
len
)
;;6 处理颜色为指定颜色的对象
;; LAYLIS
(defun Pro:color (color / D LAYER)
;;指定颜色的随层随块层名
(while (setq d (tblnext "LAYER" (null d)))
(setq layer (cdr (assoc 2 d)))
(if (equal (cdr (assoc 62 d)) color)
(setq layLis (if layLis
(strcat layLis "," layer)
layer
)
)
)
)
)
**** Hidden Message ***** 顶,看下到底怎样的用处 一般都是按颜色打印吧,都变成粗线,对看图不利,很慢 一直按线宽打印的飘过。 偶滴神啊。 你的第八条是给我拉仇恨呢吧?! :o 图层样式打印
NET-JOB 发表于 2013-7-24 15:20
一般都是按颜色打印吧,都变成粗线,对看图不利,很慢
不同专业要求的不一样吧,我们就都直接把粗线画出来,都细线反而不利于看清图纸。
wowan1314 发表于 2013-7-24 15:31
偶滴神啊。 你的第八条是给我拉仇恨呢吧?!
拉拉更健康{:soso_e130:}
关注一下!
用ellipse spline这样处理就不好玩了 Free-Lancer 发表于 2013-7-24 18:02
用ellipse spline这样处理就不好玩了
椭圆和SPLINE怎么处理好玩?
感觉只能出图前用,画图还是细线看着舒服! q3_2006 发表于 2013-7-24 18:04
感觉只能出图前用,画图还是细线看着舒服!
专业不同要求不同了,你要是画建筑施工图,都细线看着就不舒服了。
:o:o:o:o:o:o 支持黄大侠,黄大侠每每都会带给我们小惊喜!