[讨论]给一段源码大家分析

runkeji

你好：
   不知各位可以吗？在VLISP里面没人回答的。

我想这里才是分析的地方。请看：
（VL-LOAD-COM）
；；(vl-acad-defun 'gx)
(defun c:gx (/ a ent1 ent2 ent_tt)
  (setq b (ssget "x"))
  (command "_.explode" b "")
  (setq b (ssget "x"))
  (command "_.pedit" b "" "j" "" "")
(setq a (ssget "x"))
  (command "_.region" a "")
  (prompt "\n选择实体")
  (setq a (ssget "x"))
  (setq ent1 (ssname a 0))
  (setq ent2 (ssname a 1))
  ;(setq ent1 (car(entsel "\n选择从中减去的实体或选择外腔")))
  ;(setq ent2 (car(entsel "\n选择减去的实体或者选择内腔")))
  (while(or (not ent1)(not ent2))
    (prompt"\n 请重新选择实体计算差集")
     (setq ent1 (car(entsel "\n选择从中减去的实体或选择外腔")))
     (setq ent2 (car(entsel "\n选择减去的实体或选择内腔")))
    )
    (if (< (vla-get-area (vlax-ename->vla-object ent1)) (vla-get-area (vlax-ename->vla-object ent2)))
    (progn
      (setq ent_tt ent1)
       (setq ent1 ent2)
       (setq ent2 ent_tt)
      )
    )
  (command "subtract" ent1 "" ent2 "")
  (setq ent1 (entlast))
  (princ "\n")
  (setq ent2 (vla-get-momentofinertia (vlax-ename->vla-object ent1)))
  (setq lst (vlax-safearray->list (vlax-variant-value ent2)))
  (princ (strcat "惯性矩:  x值:" (rtos (car lst)1)  "\n"))
  (princ (strcat "         y值:" (rtos (cadr lst)1)  "\n"))
  (princ)
)

   这段源码以前在2004里面编的，段头用（VL-LOAD-COM）加载扩展函数。
可是到R14 里面就不识别（VL-LOAD-COM）了，VLISP FOR AutoCAD R14 已装载。也加载了VLIDE.ARX。不知为什么清高手赐教。
后来我加了（VL-ACAD-DEFUN ‘GX）后能够执行到(SETQ lst （VLAX-SAFEARRAY->LIST
  (VLAX-VARIANT-VALUE  ENT2)))  提示：
   不认识 （VLAX-VARIANT-VALUE）
为什么？清明示。如果是加载有问题会出在什么地方呢？
    希望高手们到 R14 里面试一试。

龙龙仔

;;拜托不要说在VLISP里面没人回答好吗?
;;实在是R14已不用很久了!
;;只好把R14重新安装!
;;在R14年代我还没有学vlisp呢!
;;那时只用VLIDE.ARX把LSP编释为ARX档案而已!
;;它的函数与R2000+有些不大一样!

;;不知各位可以吗？在VLISP里面没人回答的。
;;我想这里才是分析的地方。请看：
;;(vl-load-com)
;;(vl-acad-defun 'gx)
(defun C:GX (/ A B ENT1 ENT2 ENT_TT LST)
  ;;(setq B (ssget "x"))
  ;;(command "_.explode" B "")
  ;;(setq B (ssget "x"))
  ;;(command "_.pedit" B "" "j" "" "")
  (setq A (ssget "x"))
  (command "_.region" A "")
  (prompt "\n选择实体: ")
  ;;(setq A (ssget))
  ;;(setq ENT1 (ssname A 0))
  ;;(setq ENT2 (ssname A 1))
  (setq ent1 (car (entsel "\n选择从中减去的实体或选择外框: ")))
  (setq ent2 (car (entsel "\n选择减去的实体或者选择内框: ")))
  (while (or (not ENT1) (not ENT2))
    (prompt "\n 请重新选择实体计算差集")
    (setq ENT1 (car (entsel "\n选择从中减去的实体或选择外框: ")))
    (setq ENT2 (car (entsel "\n选择减去的实体或选择内框: ")))
  )
  (if (< (vla-get-area (vlax-ename->vla-object ENT1))
         (vla-get-area (vlax-ename->vla-object ENT2))
      )
    (progn
      (setq ENT_TT ENT1)
      (setq ENT1 ENT2)
      (setq ENT2 ENT_TT)
    )
  )
  (command "_.subtract" ENT1 "" ENT2 "")
  (setq ENT1 (entlast))
  (SETQ LST (vlax-get (VLAX-ENAME->VLA-OBJECT ent1) "MomentOfInertia"))
  (princ (strcat "\n惯性矩:  x值:" (rtos (car LST) 1) "\n"))
  (princ (strcat "         y值:" (rtos (cadr LST) 1) "\n"))
  ;;(setq ENT2 (vla-get-momentofinertia (vlax-ename->vla-object ENT1)))
  ;;(setq LST (vlax-safearray->list (vlax-variant-value ENT2)))
  ;;(princ (strcat "惯性矩:  x值:" (rtos (car LST) 1) "\n"))
  ;;(princ (strcat "         y值:" (rtos (cadr LST) 1) "\n"))
  (princ)
)

无痕

不明白什么意思