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

/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
)
)
)
)
)

;;*****************根据颜色，来加宽线   自贡黄明儒 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 
       ) 
) 
      ) 
    ) 
  )

游客，如果您要查看本帖隐藏内容请回复

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这样处理就不好玩了来自: Android客户端

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

支持黄大侠，黄大侠每每都会带给我们小惊喜！

账号		自动登录	找回密码
密码			立即注册

[原创] 点取对象，根据颜色加粗所有对象------终于完成

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

点评

点评

点评

点评