[讨论]：已解决

kevinchan · 发表于 2006-5-10 19:46:57

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

您需要登录才可以下载或查看，没有账号？立即注册

×

我做了一个画递增圆的程序,怎样让不同大小的圆从小到大对应的颜色也由浅到深呢?

zhang8755 · 发表于 2006-5-10 20:02:55

改变颜色容易，又浅到深不好实现

kevinchan · 发表于 2006-5-10 20:29:54

颜色是用数字来表示的,(255,255,0).应该也可以实现吧,但我不会.

雨箭风刀 · 发表于 2006-5-11 11:05:16

给实体付颜色也按递增就得了

snoopychen · 发表于 2006-5-12 10:27:06

如下是一个例子，普通256颜色
[php]
(defun c:test()
(setq i 1)
(repeat 250
(entmake
  (list (cons 0 "CIRCLE") (cons 62 i)(cons 10 (list 0.0 0.0 0.0))(cons 40 i))
)
(setq i (1+ i))
)
(command "zoom" "e" " ")
)

[/php]

如下是另外一个例子，truecolor
[php]
;;真彩色画圆，qjchen@xdcad

(defun c:test1()
(setq i 1)
(repeat 250
(VL-LOAD-COM)
(setq AcadObject (vlax-get-acad-object)
   AcadDocument (vla-get-ActiveDocument AcadObject)
   mSpace (vla-get-ModelSpace AcadDocument)
)
(setq center (vlax-make-safearray vlax-vbDouble '(0 . 2)))
(vlax-safearray-fill center '(0 0 0))
(setq radius1 i)
(setq circleObj (vla-AddCircle mSpace center radius1))
(vla-ZoomExtents AcadObject)
(setq acCmColor (vla-GetInterfaceObject (vlax-get-acad-object)
"AutoCAD.AcCmColor.16"
)
)
(vla-put-colorMethod acCmColor acColorMethodByRGB)
(vla-put-colorIndex acCmColor 7)
(vla-put-entityColor acCmColor -1073741824)
(vla-SetRGB acCmColor 0 0 i)
(vla-put-trueColor circleobj acCmColor)
(setq i (1+ i))
)
)
[/php]

xyp1964 · 发表于 2006-5-12 13:57:46

效果：

kevinchan · 发表于 2006-5-12 17:03:11

最初由 xyp1964 发布
[B]效果： [/B]

非常好，要的就是这种效果，能提供源码么？

madeinchina · 发表于 2006-5-13 00:55:27

非常巧妙

梦断江南 · 发表于 2006-5-13 03:00:47

我也来一个,真正的支持 (aci ,真彩,色卡颜色),通过颜色对话框直接选取颜色.

梦断江南 · 发表于 2006-5-13 03:39:39

来个演示
不好意思,文件比较大,压缩后色彩丢失比较多.

kevinchan · 发表于 2006-5-13 11:12:04

哪位大哥帮我把以下程序的圆改成根据直径大小的渐变来对应颜色的渐变，谢谢了！
(defun c:test1(/ a b c d1 do x i d y d2 m r y1 pt h k n)
  (setvar "osmode" 0)
(setq a 1.0)
(setq b 1.2)
(setq c 60)
(setq d1 -18)
(setq d0 18)
(setq x 4)
(setq i 1)
(
while  (and (<= x c) (>= x 4))
(setq d (* 0.5774 x))
(setq d (- 0.0 d))
(setq y  -18 )
(setq d2 (min d0 (* 0.5774 x)))
(setq m 1)
(
while (<= y 18)
(setq r (+ (* x x) (* y y)))
(setq r (sqrt r))
(setq r (* r 0.008))
(setq r (+ r 0.40))
(setq r (/ r 2.0))
(setq y1 (rem i 2))
(setq y1 (* (/ b 2) y1))
(setq y1 (- y y1))

(setq pt (list x y1))
(setq h (/ x 1.732))
(setq h (abs h))
(setq n (abs y))
(setq k (/ n x))
(setq k (/ k 0.5774))
(setq k (- k 1))
(setq k (/ k 11))
(setq k (+ k 1))

( if (and (< x 30) (> n h))
   (setq r (* (abs k) r))

)
;; (command)
(command "circle" pt r)
(setq y (+ y b))
  )

  (setq x (+ x a))
  (setq i (+ i 1))
)
)

snoopychen · 发表于 2006-5-13 12:06:09

也学梦断江南版主的选取颜色,不过现在只编了真彩对话框
[php]
;;; 真彩色画圆，qjchen@xdcad

(defun c:test1 (/ i times j color1 rcolor1 rgb1 color2 rcolor2 rgb2
   AcadObject AcadDocument mSpace center radius1 circleObj
   acCmColor
         )
  (setq i 10
times 80
j 0
  )
  (setq color1 (acad_truecolordlg (cons 420 2594)))
  (setq rcolor1 (cdr (assoc 420 (cdr color1))))
  (setq rgb1 (megetrgb rcolor1))
  (setq color2 (acad_truecolordlg (cons 420 12594)))
  (setq rcolor2 (cdr (assoc 420 (cdr color2))))
  (setq rgb2 (megetrgb rcolor2))
  (repeat times
(VL-LOAD-COM)
(setq AcadObject (vlax-get-acad-object)
   AcadDocument (vla-get-ActiveDocument AcadObject)
   mSpace (vla-get-ModelSpace AcadDocument)
)
(setq center (vlax-make-safearray vlax-vbDouble '(0 . 2)))
(vlax-safearray-fill center '(0 0 0))
(setq radius1 (* i 2))
(setq circleObj (vla-AddCircle mSpace center radius1))
(vla-ZoomExtents AcadObject)
(setq acCmColor (vla-GetInterfaceObject (vlax-get-acad-object)
      "AutoCAD.AcCmColor.16"
      )
)
(vla-put-colorMethod acCmColor acColorMethodByRGB)
(vla-put-colorIndex acCmColor 7)
(vla-put-entityColor acCmColor -1073741824)
(vla-SetRGB acCmColor (chazhi (nth 0 rgb1) (nth 0 rgb2) j times)
(chazhi (nth 1 rgb1) (nth 1 rgb2) j times) (chazhi
   (nth 2 rgb1)
   (nth 2 rgb2)
   j times
   )
)
(vla-put-trueColor circleobj acCmColor)
(setq i (1+ i)
   j (1+ i)
)
  )
)

(defun MeGetRGB (Val)
  (list (lsh Val -16) (lsh (lsh Val 16) -24) (lsh (lsh Val 24) -24))
)

(defun chazhi (a b c d / e)
  (setq a (itor a)
b (itor b)
c (itor c)
d (itor d)
  )
  (setq e (- a (* c (/ (- a b) d))))
  (setq e (fix e))
  e
)

(defun itor (a)
  (atof (itoa a))
)

[/php]

kevinchan · 发表于 2006-5-13 12:59:05

我的圆心不在同一个坐标位置上，如13楼代码。哪位高手大哥帮我改改。谢谢！

snoopychen · 发表于 2006-5-13 21:20:57

改了一下,大概和你的要求比较接近了,由于看不懂你的r是怎么变化的
所以里面这句比较奇怪 (setq rmin 0.2167 rmax 0.4506 )
这个是根据最大半径和最小半径来插值的,你可以自己改
[php]
;;; ，qjchen@xdcad

(defun c:test1 (/ a b c d1 do x i d y d2 m r y1 h k n color1 rcolor1 color2
   rcolor2
         )
  (setvar "osmode" 0)
  (setq color1 (acad_truecolordlg (cons 420 2594)))
  (setq rcolor1 (cdr (assoc 420 (cdr color1))))
  (setq rgb1 (megetrgb rcolor1))
  (setq color2 (acad_truecolordlg (cons 420 12594)))
  (setq rcolor2 (cdr (assoc 420 (cdr color2))))
  (setq rgb2 (megetrgb rcolor2))
  (setq a 1.0
b 1.2
c 60
d1 -18
d0 18
x 4
i 1
  )
  (while (and
   (<= x c)
   (>= x 4)
   )
(setq d (* -0.5774 x))
(setq y -18)
(setq d2 (min
         d0
         (* 0.5774 x)
      )
)
(setq m 1)
(while (<= y 18)
   (setq r (/ (+ (* (sqrt (+ (* x x) (* y y))) 0.008) 0.40) 2.0))
   (setq y1 (- y (* (/ b 2) (rem i 2))))
   (setq pt (list x y1 0.0))
   (setq h (abs (/ x 1.732)))
   (setq n (abs y))
   (setq k (1+ (/ (- (/ (/ n x) 0.5774) 1) 11)))
   (if (and
      (< x 30)
      (> n h)
   )
(setq r (* (abs k) r))

   )
   (drawandcolor pt r)
   (setq y (+ y b))
)

(setq x (+ x a))
(setq i (1+ i))
  )
)

(defun drawandcolor (pt r / i times j color1 rcolor1 color2 rcolor2
AcadObject AcadDocument mSpace center radius1
circleObj acCmColor
      )
  (setq rmin 0.2167
rmax 0.4506
  )
  (setq ratio (/ (- r rmin) (- rmax rmin)))
  (VL-LOAD-COM)
  (setq AcadObject (vlax-get-acad-object)
AcadDocument (vla-get-ActiveDocument AcadObject)
mSpace (vla-get-ModelSpace AcadDocument)
  )
  (setq center (vlax-make-safearray vlax-vbDouble '(0 . 2)))
  (vlax-safearray-fill center pt)
  (setq radius1 r)
  (setq circleObj (vla-AddCircle mSpace center radius1))
  (vla-ZoomExtents AcadObject)
  (setq acCmColor (vla-GetInterfaceObject (vlax-get-acad-object)
   "AutoCAD.AcCmColor.16"
   )
  )
  (vla-put-colorMethod acCmColor acColorMethodByRGB)
  (vla-put-colorIndex acCmColor 7)
  (vla-put-entityColor acCmColor -1073741824)
  (vla-SetRGB acCmColor (chazhi (nth 0 rgb1) (nth 0 rgb2) ratio)
      (chazhi (nth 1 rgb1) (nth 1 rgb2) ratio) (chazhi (nth 2 rgb1)
         (nth 2 rgb2)
         ratio
         )
  )
  (vla-put-trueColor circleobj acCmColor)

)

(defun MeGetRGB (Val)
  (list (lsh Val -16) (lsh (lsh Val 16) -24) (lsh (lsh Val 24) -24))
)

(defun chazhi (a b c / e)
  (setq a (itor a)
b (itor b)
  )
  (setq e (- a (* c (/ (- a b)))))
  (setq e (fix e))
  e
)

(defun itor (a)
  (atof (itoa a))
)

[/php]

zxq0220 · 发表于 2006-5-13 21:49:45

最初由 kevinchan 发布
[B]哪位大哥帮我把以下程序的圆改成根据直径大小的渐变来对应颜色的渐变，谢谢了！
(defun c:test1(/ a b c d1 do x i d y d2 m r y1 pt h k n)
(setvar "osmode" 0)
(setq a 1.0)
... [/B]

楼主是做手机屏幕的吧？
[php]
(defun c:test1 (/ a b c d1 do x i d y d2 m r y1 pt h k n)
(setvar "CMDECHO" 0) (setvar "osmode" 0) (setvar "BLIPMODE" 0)
(setq a 1.0  b 1.2  c 60  d1 -18  d0 18  x 4  i 1)
(while (<= 4 x c)
(setq d (* -0.5774 x))
(setq y -18)
(setq d2 (min d0 (* 0.5774 x)))
(setq m 1)
(while (<= y 18)
  (setq r (+ (* (sqrt (+ (* x x) (* y y))) 0.004) 0.2))
  (setq y1 (- y (* (/ b 2) (rem i 2))))
  (setq pt (list x y1))
  (setq h (abs (/ x 1.732)))
  (setq n (abs y))
  (setq k (1+ (/ (- (/ (/ n x) 0.5774) 1) 11)))
  (if (and (< x 30) (> n h))
(setq r (* (abs k) r))
  )
  (command "-color" "t"
         (strcat (itoa (* (ABS (fix y)) 14)) "," (itoa (* i 4)) "," (itoa (* (fix x) 4)))
         "circle" pt r)
  (setq y (+ y b))
)
(setq x (+ x a))
(setq i (1+ i))
)
(SETVAR "BLIPMODE" 1)
(SETVAR "CMDECHO" 1)
(PRINC)
)
[/php]

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

[已解决] [讨论]：已解决

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

相关帖子