找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

楼主: kevinchan

[已解决] [讨论]:已解决

[复制链接]
 楼主| 发表于 2006-5-13 23:27:32 | 显示全部楼层
最初由 snoopychen 发布
[B]改了一下,大概和你的要求比较接近了,由于看不懂你的r是怎么变化的
所以里面这句比较奇怪 (setq rmin 0.2167 rmax 0.4506 )
这个是根据最大半径和最小半径来插值的,你可以自己改
[php]
;;; ,qjchen@xdcad

(de... [/B]

15楼的程序不错,可以稍微改一下改成框选所有圆,并进行颜色渐变!
非常感谢!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2006-5-14 01:28:41 | 显示全部楼层
参考:
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2006-5-14 10:07:07 | 显示全部楼层
  1. [FONT=courier new](load "xyp_lib.vlx")                        ;版本 V.20060515
  2. ;|下载和加载通用函数(可在签名栏直接下载后放到搜索路径下)
  3. 利用以下任何一种方式(首选第一种)即可加载和运行通用函数内的所有子程序:
  4. ★1·在acad.lsp中增加(load"xyp_lib.vlx")
  5. ■2·在每个程序内增加(load"xyp_lib.vlx")
  6. ■3·在command下,输入(load"xyp_lib.vlx")
  7. ■4·在菜单.mnl中增加(load"xyp_lib.vlx")
  8. ■5·将xyp_lib.vlx文件直接拽到cad屏幕
  9. [COLOR=red] ★通用函数下载地址:[/COLOR]
  10. [url]http://www.xdcad.net/forum/attachment.php?s=&postid=1606661[/url]
  11. [url]http://free.ys168.com/?xyp1964[/url]
  12. |;

  13. (defun c:test ()
  14.   (cmdla0)
  15.   (setq ss1 (SSALL))
  16.   (main)
  17.   (setq        ss  (ssdiff (SSALL) ss1)
  18.         plst (xyp-Sort-PList (xyp-Sort ss 40 "none") 9)
  19.         j    0
  20.   )
  21.   (foreach sn plst
  22.     (setq s1 (cdr sn)
  23.           j  (1+ j)
  24.     )
  25.     (xyp-put-TrueColor j s1)
  26.   )
  27.   (cmdla1)
  28. )
  29. (defun main ()
  30.   (setvar "osmode" 0)
  31.   (setq        a  1.0
  32.         b  1.2
  33.         c  60
  34.         d1 -18
  35.         d0 18
  36.         x  4
  37.         i  1
  38.   )
  39.   (while (and (<= x c) (>= x 4))
  40.     (setq d  (* 0.5774 x -1.0)
  41.           y  -18
  42.           d2 (min d0 (* 0.5774 x))
  43.           m  1
  44.     )
  45.     (while (<= y 18)
  46.       (setq r  (/ (+ (* (sqrt (+ (* x x) (* y y))) 0.008) 0.40) 2.0)
  47.             y1 (- y (* (/ b 2) (rem i 2)))
  48.             pt (list x y1)
  49.             h  (abs (/ x 1.732))
  50.             n  (abs y)
  51.             k  (+ (/ (- (/ (/ n x) 0.5774) 1) 11) 1)
  52.       )
  53.       (if (and (< x 30) (> n h))
  54.         (setq r (* (abs k) r))
  55.       )
  56.       (command "circle" pt r)
  57.       (setq y (+ y b))
  58.     )
  59.     (setq x (+ x a)
  60.           i (+ i 1)
  61.     )
  62.   )
  63. )[/FONT]
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2006-5-14 10:16:26 | 显示全部楼层
最初由 xyp1964 发布
[B][CODE](load "xyp_lib.vlx")                        ;版本 V.20060515
;|下载和加载通用函数(可在签名栏直接下载后放到搜索路径下)
利用以下任何一种方式(首选第一种)即可加载和运行通用函数内的所有子程序:
★1... [/B]

运行有错误
Command: test
Font file doesn't exist.Unknown command "0".  Press F1 for help.
Unknown command "1".  Press F1 for help.
Unknown command "0".  Press F1 for help.
Unknown command "TEST".  Press F1 for help.
Unknown command "TEST".  Press F1 for help.
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2006-5-14 15:36:23 | 显示全部楼层
最初由 kevinchan 发布
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2006-5-14 19:13:18 | 显示全部楼层
同样运行在命令栏有错误,
Font file doesn't exist.Unknown command "0".  Press F1 for help.
Unknown command "1".  Press F1 for help.
Unknown command "0".  Press F1 for help.
Unknown command "JBS".  Press F1 for help.
Unknown command "JBS".  Press F1 for help.
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2006-5-14 20:38:55 | 显示全部楼层
最初由 kevinchan 发布
[B]同样运行在命令栏有错误,
Font file doesn't exist.Unknown command "0".  Press F1 for help.
Unknown command "1".  Press F1 for help.
Unknown command "0".  Press F1 for help.
Unknown command "JBS".  ... [/B]

编译程序命令:jbs
效果
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2006-5-14 23:03:11 | 显示全部楼层
学习了一下xyp版主的图,觉得原来用rgb插值的方法并不好,改成如下的hsl插值方法,
这个期间,到easyrgb网站找到hsl和rgb转换的公式
下面这个程序是按照16楼的意思,选取一堆圆,按照半径大小来渐变颜色,在对话框选颜色的时候,最好先选靠右边的颜色,再选靠左边的颜色,这样的效果好些,这是程序编写不够严密之故
[php]
;;; 选圆改变渐变色,采用hsl值插值的方法 qjchen@xdcad

(defun c:test2 (/ rgb1 hsl1 rgb2 hsl2 color1 rcolor1 color2 rcolor2 rmin rmax sscircle i cirr cirobj ratio irgb
               )
  (setvar "osmode" 0)
  ;;;get the start color and end color
  (setq color1 (acad_truecolordlg (cons 420 2594)))
  (setq rcolor1 (cdr (assoc 420 (cdr color1))))
  (setq rgb1 (megetrgb rcolor1))
  (setq hsl1 (MeCalcHslModel rgb1))
  (setq color2 (acad_truecolordlg (cons 420 12594)))
  (setq rcolor2 (cdr (assoc 420 (cdr color2))))
  (setq rgb2 (megetrgb rcolor2))
  (setq hsl2 (MeCalcHslModel rgb2))
  (setq sscircle (ssget '((0 . "Circle"))))
  (setq i 0)
  ;;;get the maximum and minimum radius of the circle
  (repeat (sslength sscircle)
    (setq cirr (cdr (assoc 40 (entget (ssname sscircle i)))))
    (if (= i 1)
      (setq rmin cirr
            rmax cirr
      )
    )
    (if (< cirr rmin)
      (setq rmin cirr)
    )
    (if (> cirr rmax)
      (setq rmax cirr)
    )
    (setq i (1+ i))
  )

  (setq i 0)
  (repeat (sslength sscircle)
    (setq cirr (cdr (assoc 40 (entget (ssname sscircle i)))))
    (setq cirobj (vlax-ename->vla-object (ssname sscircle i)))
    (setq ratio (/ (- cirr rmin) (- rmax rmin)))
    (setq irgb (intercolor hsl1 hsl2 ratio))
    (puttruecolor cirobj ratio irgb)
    (setq i (1+ i))
  )
)


;;color interpolation
(defun intercolor(shsl1 shsl2 sratio / interhsl interrgb)
  (setq interhsl (list (interpolating (nth 0 shsl1) (nth 0 shsl2) sratio)
                        (interpolating (nth 1 shsl1) (nth 1 hsl2) sratio)
                        (interpolating (nth 2 shsl1) (nth 2 hsl2) sratio)
                  )
  )
  (setq interrgb (hsl2rgb interhsl))
  interrgb
)


;;put true color to object
(defun puttruecolor (obj rati interrgb / AcadObject AcadDocument mSpace center
                         acCmColor
                    )
  (VL-LOAD-COM)
  (setq AcadObject (vlax-get-acad-object)
        AcadDocument (vla-get-ActiveDocument AcadObject)
        mSpace (vla-get-ModelSpace AcadDocument)
  )
  (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 (nth 0 interrgb) (nth 1 interrgb) (nth 2 interrgb)
  )
  (vla-put-trueColor obj acCmColor)
)


;;;;;GetRGB value
(defun MeGetRGB (Val)
  (list (lsh Val -16) (lsh (lsh Val 16) -24) (lsh (lsh Val 24) -24))
)


;;function for interpolating by qjchen,
;;not a b should be integer,c should be real between [0,1]
;;so start from a 0 and end b 1, c is the ratio between a and b
(defun interpolating (a b c / e)
  (setq a (itor a)
        b (itor b)
  )
  (setq e (- a (* c (/ (- a b)))))
  (setq e (fix e))
  e
)

;;;function for convert integer to real
(defun itor (a)
  (atof (itoa a))
)


;;;convert hsl value to rgb value,by qjchen at xdcad
;;;HSL value should be integer
;;;The formular is obtained from the website of easyRGB
;;;The hsl is taken from Autocad H:[0,360],S:[0,100],L:[0,100]

(defun hsl2rgb (hsllist / h s l r g b var2 var1)
  (setq h (/ (nth 0 hsllist) 360.0)
        s (/ (nth 1 hsllist) 100.0)
        l (/ (nth 2 hsllist) 100.0)
  )
  (cond
    ((= s 0)
      (setq r (* l 255)
            g (* l 255)
            b (* l 255)
      )
    )
    ((/= s 0)
      (cond
        ((< l 0.5)
          (setq var2 (* l (1+ s)))
        )
        (t
          (setq var2 (- (+ l s) (* s l)))
        )
      )
      (setq var1 (- (* 2 l) var2))
      (setq r (* 255 (func var1 var2 (+ h 0.33333))))
      (setq g (* 255 (func var1 var2 h)))
      (setq b (* 255 (func var1 var2 (- h 0.33333))))
    )
  )
  (list (fix r) (fix g) (fix b))
)

(defun func (v1 v2 vh / result)
  (if (< vh 0)
    (setq vh (1+ vh))
  )
  (if (> vh 1)
    (setq vh (- vh 1))
  )
  (cond
    ((< (* 6 vh) 1)
      (setq result (+ v1 (* 6 vh (- v2 v1))))
    )
    ((< (* 2 vh) 1)
      (setq result v2)
    )
    ((< vh 0.66667)
      (setq result (+ v1 (* 6 (- v2 v1) (- 0.666667 vh))))
    )
    (t
      (setq result v1)
    )
  )
  result
)

; Author      :   jme
; Copyright   :   MENZI ENGINEERING GmbH, Switzerland
;;; by Menzi, for convert rgb value to hsl value
(defun MeCalcHslModel (Rgb / ColDta ColHue ColLum ColSat MaxVal MinVal
                           TmpRgb
                      )
  (setq TmpRgb (mapcar
                 '/
                 Rgb
                 '(255.0 255.0 255.0)
               )
        MaxVal (apply
                 'max
                 TmpRgb
               )
        MinVal (apply
                 'min
                 TmpRgb
               )
        ColDta (- MaxVal MinVal)
        ColLum (/ (+ MaxVal MinVal) 2.0)
        ColSat 0.0
        ColHue 0.0
  )
  (if (/= MaxVal MinVal)
    (setq ColSat (if (<= ColLum 0.5)
                   (/ ColDta (+ MaxVal MinVal))
                   (/ ColDta (- 2.0 MaxVal MinVal))
                 )
          ColHue (cond
                   ((= (car TmpRgb) MaxVal)
                     (/ (- (cadr TmpRgb) (caddr TmpRgb)) ColDta)
                   )
                   ((= (cadr TmpRgb) MaxVal)
                     (+ 2.0 (/ (- (caddr TmpRgb) (car TmpRgb)) ColDta))
                   )
                   ((= (caddr TmpRgb) MaxVal)
                     (+ 4.0 (/ (- (car TmpRgb) (cadr TmpRgb)) ColDta))
                   )
                 )
          ColHue (* ColHue 60.0)
          ColHue (if (minusp ColHue)
                   (+ ColHue 360.0)
                   ColHue
                 )
    )
  )

  (list (if (> ColSat 0.0)
          (fix ColHue)
          nil
        ) (fix (* ColSat 100.0)) (fix (* ColLum 100.0))
  )
)
[/php]
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2006-5-15 00:31:11 | 显示全部楼层
挺不错的, 已经很完美了.
如果选择的不是圆,而是矩形或者菱形,又或者是椭圆呢?
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2006-5-15 09:02:47 | 显示全部楼层
假如是相似型的话,有一个可以用数学公式描述其相对大小的就都不难,只是繁琐而已
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2006-5-15 13:53:57 | 显示全部楼层
依据实体面积排序的颜色渐变:
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2006-5-15 13:54:25 | 显示全部楼层
stjbs(实体渐变色)
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2006-10-11 12:07:16 | 显示全部楼层
我也来一个,AUTOCAD小狗图
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2006-10-11 12:19:40 | 显示全部楼层
楼上这个作的不错嘛
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2024-11-6 07:27 , Processed in 0.482608 second(s), 51 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

快速回复 返回顶部 返回列表