用lisp调用dcl显示图像的基本程序

荒野孤行

以下是WDY工具箱里面调用头像的相关函数，很多是从论坛上收集的，以下代码只可支持AutoCAD部分版本和中望CAD201及以上版本，使用天正CAD的坛友亦希望WDY工具箱可在天正中望CAD里面使用，请大家帮忙优化。

已解决的帖子：http://bbs.mjtd.com/thread-110628-1-1.html

以下红色部分是需要重点修改的：
(defun wdy-make-img2 (key image /)
  (setq version (substr (getvar 'acadver) 1 2))
  (setq version (strcat "AutoCAD.AcCmColor." version))
  (setq colorobj (vlax-create-object version))
  (if (not colorobj)
      (setq colorobj (vlax-create-object "ZWCAD.ZcCmColor"))
  )
  (start_image key)
  (setq        xx (dimx_tile key)
        yy (dimy_tile key)
  )
  (fill_image 0 0 xx yy 61)
  (foreach pt image
    (setq x (car pt))
    (setq y (cadr pt))
    (setq r (nth 2 pt))
    (setq g (nth 3 pt))
    (setq b (nth 4 pt))
    (setq indexcolor (rgb2index colorobj r g b))
    (if        (/= 0 (last pt))
      (fill_image x y 1 1 indexcolor)
    )
  )
  (end_image)
)
(defun rgb2index (colorobj r g b / i)
  (if (and (equal 0 r 10) (equal 0 g 10) (equal 0 b 10))
    -16
    (progn
      (vla-setrgb colorobj r g b)
      (setq i (vla-get-colorindex colorobj))
      (if (= i 7)
        -15
        i
      )
    )
  )
)

liu_kunlun

试一下Li mac的函数
; RGB -> ACI - Lee Mac 2011
;; Args: r,g,b - Red,Green,Blue values

(defun LM:RGB->ACI ( r g b / cObj aci ) (vl-load-com)
  (if
    (and
      (setq cObj
        (vla-getInterfaceObject (vlax-get-acad-object)
          (strcat "AutoCAD.AcCmColor." (substr (getvar 'ACADVER) 1 2))
        )
      )
      (not
        (vl-catch-all-error-p
          (vl-catch-all-apply 'vla-SetRGB (list cObj r g b))
        )
      )
    )
    (setq aci (vla-get-ColorIndex cObj))
  )
  (if cObj (vlax-release-object cObj))
  aci
)

caogis

楼主太有才了

894560869

仰慕版主啊 感谢分享源码！

tianying307

感谢楼主分享，但不知道为什么我的中望机械版2020的就不行，(setq colorobj (vlax-create-object "ZWCAD.ZcCmColor"))这条没有值，但2022试用版的就没问题

w090212y

右下角这个图标按钮怎么实现的