请教：当先选图形后执行命令时图形未选中

fengyu6913

这是个计算填充面积的程序，最终把有效的填充选中
问题：当先选图形后执行命令时，命令结束后有效的填充对象没有被选中，等再次点击屏幕时才会选中
请教：如何解决？



;;;功能：向系统剪切板写入文字   guosheyang
(vl-load-com)
(defun SET-CLIP-STRING (STR / HTML RESULT)
    (and (= (type STR) 'STR)
         (setq HTML (vlax-create-object "htmlfile"))
         (setq RESULT (vlax-invoke
                          (vlax-get (vlax-get HTML 'PARENTWINDOW)
                                    'CLIPBOARDDATA
                          )
                          'SETDATA
"Text"
                          STR
                      )
         )
         (vlax-release-object HTML)
    )
)


(defun c:tt (/ *acad* *doc* ss i ent obj area total_area insunits unit-name conversion-factor
                valid-ss failed-count)
  (vl-load-com)
  (setq *acad* (vlax-get-acad-object))
  (setq *doc* (vla-get-activedocument *acad*))
  
  ; 获取文档单位设置
  (setq insunits (getvar "INSUNITS"))
  (cond
    ((= insunits 0)  ; 无单位
      (setq conversion-factor 1000000.0  ; 默认按mm计算
            unit-name "毫米(mm)")
      (alert (strcat "文档单位设置为\"无单位\"，程序将按默认单位" unit-name "进行计算。"))
    )
    ((= insunits 1)  ; 英寸
      (setq conversion-factor 1550.0031
            unit-name "英寸(in)"))
    ((= insunits 2)  ; 英尺
      (setq conversion-factor 92903.04
            unit-name "英尺(ft)"))
    ((= insunits 4)  ; 毫米
      (setq conversion-factor 1000000.0
            unit-name "毫米(mm)"))
    ((= insunits 5)  ; 厘米
      (setq conversion-factor 10000.0
            unit-name "厘米(cm)"))
    ((= insunits 6)  ; 米
      (setq conversion-factor 1.0
            unit-name "米(m)"))
    (t
      (setq conversion-factor 1000000.0  ; 其他单位默认按mm
            unit-name "毫米(mm)")
      (alert (strcat "未知单位设置(INSUNITS=" (itoa insunits) ")，程序将按默认单位" unit-name "进行计算。"))
    )
  )
  
  (princ (strcat "\n当前文档单位: " unit-name "，将转换为平方米(m2)"))
  
  (princ "\n选择要计算面积的填充图案: ")
  (setq ss (ssget '((0 . "HATCH"))))
  
  (if ss
    (progn
      (setq total_area 0.0
            failed-count 0
            valid-ss (ssadd))  ; 创建空选择集用于存放有效填充
      
      (repeat (setq i (sslength ss))
        (setq ent (ssname ss (setq i (1- i))))
        (setq obj (vlax-ename->vla-object ent))
        
        ; 尝试计算面积，捕获可能的错误
        (if (vl-catch-all-error-p
              (setq area (vl-catch-all-apply 'vla-get-area (list obj))))
          (progn
            ; 计算失败处理
            (setq failed-count (1+ failed-count))
          )
          (progn
            ; 计算成功处理
            (setq total_area (+ total_area area))
            (ssadd ent valid-ss)  ; 将有效填充添加到选择集
            (princ (strcat "\n填充图案面积: " (rtos (/ area conversion-factor) 2 2) " 平方米"))
          )
        )
      )
      
      ; 显示统计结果
      (princ (strcat "\n\n===== 统计结果 ====="))
      (princ (strcat "\n有效填充图案: " (itoa (sslength valid-ss)) " 个"))
      (princ (strcat "\n总面积: " (rtos (/ total_area conversion-factor) 2 2) " 平方米"))

      (SET-CLIP-STRING (rtos (/ total_area conversion-factor) 2 2)) ;;面积写入剪贴板
      
      (if (> failed-count 0)
        (progn
          (princ (strcat "\n无效填充图案(无法计算面积): " (itoa failed-count) " 个"))
          (alert (strcat "注意：有 " (itoa failed-count) " 个填充图案无法计算面积"))
        )
      )
      
      ; 只选中可以计算面积的填充对象
      (if (> (sslength valid-ss) 0)
        (sssetfirst nil valid-ss)
        (princ "\n没有找到可以计算面积的填充图案。")
      )
    )
    (princ "\n未选择任何填充图案。")
  )
  (princ)
)

guosheyang

倒数第二行加上  (vl-cmdf "regen")  试下

qazxswk

我在浩辰上运行正常，不知道你在其他平台上运行是什么状态。可以录个视频给大家看看。

fengyu6913

guosheyang 发表于 2025-6-18 11:00
倒数第二行加上  (vl-cmdf "regen")  试下

谢谢大佬
一下就解决了