/db_自贡黄明儒_ 发表于 2013-7-24 15:09:36

点取对象,根据颜色加粗所有对象------终于完成

本帖最后由 /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 *****

yzr2002626 发表于 2013-7-24 15:14:48

顶,看下到底怎样的用处

NET-JOB 发表于 2013-7-24 15:20:54

一般都是按颜色打印吧,都变成粗线,对看图不利,很慢

wowan1314 发表于 2013-7-24 15:29:21

一直按线宽打印的飘过。

wowan1314 发表于 2013-7-24 15:31:56

偶滴神啊。 你的第八条是给我拉仇恨呢吧?! :o

snsj 发表于 2013-7-24 15:38:31

图层样式打印

Lisphk 发表于 2013-7-24 15:44:11

NET-JOB 发表于 2013-7-24 15:20
一般都是按颜色打印吧,都变成粗线,对看图不利,很慢

不同专业要求的不一样吧,我们就都直接把粗线画出来,都细线反而不利于看清图纸。

NET-JOB 发表于 2013-7-24 17:09:19

wowan1314 发表于 2013-7-24 15:31
偶滴神啊。 你的第八条是给我拉仇恨呢吧?!

拉拉更健康{:soso_e130:}

q3_2006 发表于 2013-7-24 18:01:20

关注一下!

Free-Lancer 发表于 2013-7-24 18:02:13

用ellipse spline这样处理就不好玩了

marting 发表于 2013-7-24 18:04:00

Free-Lancer 发表于 2013-7-24 18:02
用ellipse spline这样处理就不好玩了

椭圆和SPLINE怎么处理好玩?

q3_2006 发表于 2013-7-24 18:04:47

感觉只能出图前用,画图还是细线看着舒服!

newer 发表于 2013-7-24 18:32:46

q3_2006 发表于 2013-7-24 18:04
感觉只能出图前用,画图还是细线看着舒服!

专业不同要求不同了,你要是画建筑施工图,都细线看着就不舒服了。

429014673 发表于 2013-7-24 22:10:03

:o:o:o:o:o:o

HLCAD 发表于 2013-7-25 08:05:56

支持黄大侠,黄大侠每每都会带给我们小惊喜!
页: [1] 2 3 4
查看完整版本: 点取对象,根据颜色加粗所有对象------终于完成