求助：把图案填充编辑中把透明度指定值改为80

yy6831817

(defun c:HM (/ *error* acadDoc ms pts nextpt pline hatch obj area len txt ins th
                acadVer hasTransparency mtextObj finalPline finalHatch)
  (vl-load-com)

  ;; 定义AutoCAD常量
  (if (not (boundp 'acHatchPatternTypePredefined))
    (setq acHatchPatternTypePredefined 0))

  ;; 检查AutoCAD版本是否支持透明度属性
  (setq acadVer (atoi (getvar "ACADVER")))
  (setq hasTransparency (>= acadVer 18)) ; 2010及以上版本支持

  ;; ---------- 错误处理 ----------
  (defun *error* (msg)
    (if (and msg (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")))
      (princ (strcat "\n错误: " msg)))
    ;; 只清理临时对象，保留最终对象
    (if (and pline (not (eq pline finalPline)))
      (vla-delete (vlax-ename->vla-object pline)))
    (if (and hatch (not (eq hatch finalHatch)))
      (vla-delete hatch))
    (princ))

  ;; ---------- 初始化 ----------
  (setq acadDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
  (setq ms      (vla-get-ModelSpace acadDoc))
  (setq pts     nil
        pline   nil
        hatch   nil
        finalPline nil
        finalHatch nil)

  ;; ---------- 主循环：实时绘制 ----------
  (while
    (setq nextpt
      (if pts
        (getpoint (last pts) "\n下一点(回车结束): ")
        (getpoint "\n起点: ")))
    (setq pts (append pts (list nextpt)))

    ;; 删除临时对象（保留最终对象）
    (if (and pline (not (eq pline finalPline)))
      (vla-delete (vlax-ename->vla-object pline)))
    (if (and hatch (not (eq hatch finalHatch)))
      (vla-delete hatch))

    ;; 创建新的闭合多段线
    (setq pline
      (entmakex
        (append
          (list
            '(0 . "LWPOLYLINE")
            '(100 . "AcDbEntity")
            '(100 . "AcDbPolyline")
            (cons 90 (length pts))
            '(70 . 1)                 ; 闭合
            '(40 . 0.0)               ; 线宽
            '(62 . 1)                 ; 颜色设为红色，确保可见
            )
          (mapcar '(lambda (p) (cons 10 p)) pts))))

    ;; 若点数≥3，立即生成填充
    (if (and pline (>= (length pts) 3))
      (progn
        (setq hatch
          (vla-AddHatch ms
                        acHatchPatternTypePredefined
                        "SOLID"
                        :vlax-true))
        ;; 设置填充为颜色252（浅黄）
        (vla-put-Color hatch 251)
        
        ;; 设置透明度为80（仅支持版本）
        (if hasTransparency
          (vl-catch-all-apply
            '(lambda ()
               (vla-put-Transparency hatch 80)
            ))
        )

        (vla-AppendOuterLoop
          hatch
          (vlax-make-variant
            (vlax-safearray-fill
              (vlax-make-safearray vlax-vbObject '(0 . 0))
              (list (vlax-ename->vla-object pline)))))
        (vla-Evaluate hatch))))

  ;; ---------- 保存最终对象引用 ----------
  (setq finalPline pline)
  (setq finalHatch hatch)

  ;; ---------- 结束：标注面积/周长 ----------
  (if (and finalPline (>= (length pts) 3))
    (progn
      (setq obj  (vlax-ename->vla-object finalPline))
      (setq area (/ (vlax-get-property obj 'Area) 1e6))   ; mm² → m²
      (setq len  (/ (vlax-get-property obj 'Length) 1e3)) ; mm  → m
      (setq txt  (strcat "面积=" (rtos area 2 3) "m²"
                         "/周长=" (rtos len  2 3) "m"))

      (if (setq ins (getpoint "\n标注位置: "))
        (progn
          (initget 6)
          (setq th (getreal "\n文字高度<100>: "))
          (if (not th) (setq th 100.0))

          ;; 创建标注文字
          (setq mtextObj
            (vla-AddMText ms
                          (vlax-3d-point ins)
                          0.0  ; 宽度
                          txt))

          ;; 设置文字属性
          (vla-put-Height mtextObj th)
          (vla-put-AttachmentPoint mtextObj 1)  ; 居中对齐
          (vla-put-HorizontalAlignment mtextObj 1)

          (princ "\n图形、填充和标注已全部创建完成。"))
        (princ "\n未指定标注位置，仅保留图形和填充。")))
    (princ "\n未形成闭合区域，已取消。"))

  (princ)
)
    修改：        ;; 设置透明度为80（仅支持版本）
        (if hasTransparency
          (vl-catch-all-apply
            '(lambda ()
               (vla-put-Transparency hatch 80)
            ))
        )      
修改：这设置透明度为80没起作用（CAD2025，图案填充编辑中把透明度指定值改为80）求老师修改一下，我在AI中修改总是不行。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。

kozmosovia

ketxu 发表于 2025-7-24 11:45
您可以将（列表 （cons 440 33554495））附加到实体数据中，以将填充线透明度设置为 80 :)

不同原始颜色，不同透明度的440数值是不一样的。只有提前预知，才能直接用440

kozmosovia

不能用vla-put改透明度，需要用(setpropertyvalue obj "Transparency" val)

yy6831817

kozmosovia 发表于 2025-7-23 21:10
不能用vla-put改透明度，需要用(setpropertyvalue obj "Transparency" val)

谢谢，老师牛，OK了

mokson

用 change 命令更改属性就可以了。
(command "change" (car (entsel)) "" "P" "TR" 80 "")(princ)

ketxu

您可以将（列表 （cons 440 33554495））附加到实体数据中，以将填充线透明度设置为 80 :)

yonjay

大佬，打印照片设置成透明度打印，图片为什么是倾斜拉伸变形的？

yonjay

看你们好多用lisp，目前只会arx，lisp有必要学吗？

kozmosovia

yonjay 发表于 2025-7-24 21:31
看你们好多用lisp，目前只会arx，lisp有必要学吗？

lisp能干的arx都能干，只要没有嫌分发ARX麻烦的，还是保持ARX更好。

yonjay

谢谢大佬，感觉，现在用c#的挺活跃的