[求助]程序有很多问题多多指教

runkeji

(vl-load-com)
(defun c:san()
  (prompt "选择多义线的编辑\n")
  (setq set1 (ssget))
  (command "pedit" set1 "" "j" "" "")
  ;;;;*******求多义线的长宽**************
  ;;;;******* 实现方法取表头元素，测试表头表含有10 MEMBER  与 CAR
  ;;;;*******
  (setq rectu (car(entsel "选择要提取数据的图形")))
  (setq lstg (entget rectu))
  (while (assoc 10 lstg)
     (progn
      (setq lst (assoc 10 latg))
      (setq lstg_x (member lst lstg))
       ;;;;******可以通过CDR 操作 LSTG-X的值。当然也可以通过(VL-REMOVE "删除元素的值" " table")
       (setq lstg_x_1 (vl-remove lst lstg))
      ;(setq lstg_x_1(cdr lstg_x))
      (setq lstg (list lstg_x_1))
      )
    )
  ;;;;;*******从LSTG 中取出四个点的坐标，每个坐标分别比较如果
  ;;;;; x 相同计算Y的差值，写入 H 变量，相反，计算X的差值写入
  ;;;;; 变量 B 中。******************************************
  ;(setq i 0)
  ;(setq num (vl-list-length lstg))
; (while (/= i num)
    (setq zv (car lstg))
    (setq zv_x (car zv))
    (setq zv_y (cdr zv))
    (setq zh (cdr lstg))
    (setq zv_cy (assoc av_x zh))
    (setq h (abs(- zv_y (cdr zv_cy))))
    (setq zv_cx (assoc zv_y zh))
    (setq b (abs(- zv_x (car zv_cx))))
    (princ (rtos h) "\n")
    (princ (rtos b) "\n")
    ;(setq l(cdr lst))
  ;;;;***
  (prompt "选择所要创造的面域的集合\n")
  (setq set1 (ssget))
  (command "region" set1 "")
  (setq num (sslength set1))
  (setq i 0)
; (if (/= i num)
   ; (progn
    (prompt "选择各个面域")
    (setq ent1 (car(entsel"")))
    (setq ent2 (car(entsel "")))
    (setq ent3(car(entsel "")))
    ;)
    ;)
  ;;;;************* 取得各个质心数据*****************************
  (setq zh1 (vla-get-centroid (vlax-ename->vla-object ent1)))
  (setq zh2 (vla-get-centroid (vlax-ename->vla-object ent2)))
  (setq zh3 (vla-get-centroid (vlax-ename->vla-object ent3)))
  (setq lst1 (vlax-safearray->list (vlax-variant-value zh1)))
  (setq lst2 (vlax-safearray->list (vlax-variant-value zh2)))
  (setq lst3 (vlax-safearray->list (vlax-variant-value zh3)))
  ;;;;;;*************** GET THIS AREA ***************************
  (SETQ  area1 (vla-get-area (vlax-ename->vla-object ent1)))
  (SETQ  area2 (vla-get-area (vlax-ename->vla-object ent2)))
  (SETQ  area3 (vla-get-area (vlax-ename->vla-object ent3)))
  ;;;;******************总的面域的形心***************************
  (command "._union" ent1 ent2 ent3 "")
  (setq ent4 (entlast))
  (setq zh4 (vla-get-centroid (vlax-ename->vla-object ent4)))
  (setq lst4 (vlax-safearray->list (vlax-variant-value zh4)))
  ;;;;;;****************  get width and length of evary entity 到参考轴X的形心矩***
  (setq lst1_y (cadr lst1))
  (setq lst2_y (cadr lst2))
  (setq lst3_y (cadr lst3))
  (setq lst4_y (cadr lst3))
  (setq LL1 (abs(- lst4_y lst1_y)))
  (setq LL2 (abs(- lst4_y lst2_y)))
  (setq LL3 (abs(- lst4_y lst3_y)))
  ;;;;****************** get width and length of every entity  to Y long
  (setq lst1_x (car lst1))
  (setq lst2_x (car lst2))
  (setq lst3_x (car lst3))
  (setq lst4_x (car lst4))
  (setq yy1 (abs(- lst1_x lst4_x)))
  (setq yy2 (abs(- lst2_x lst4_x)))
  (setq yy3 (abs(- lst3_x lst4_x)))
  ;;;;************ y in the x leng**************************************
  (setq xc (cadr lst4))
  ;;;;************* move zhou ******************************************
  (setq ofset1 (abs(- xc yy1)))
  (setq ofset2 (abs(- xc yy2)))
  (setq ofset3 (abs(- xc yy3)))
  ;;;;;************ go to the 惯性矩*****************************
  (setq iy1 (* area1 (* yy1 yy1)))
  (setq iy2 (* area2 (* yy2 yy2)))
  (setq iy3 (* area3 (* yy3 yy3)))
  (setq iy (+ (+ iy1 iy2) iy3))
  (setq iys (rtos iy))
  ;;;;;***********X轴在Y 轴的距离********************************
  (setq yc (/(+(* area1 lst1_y) (* area2 lst2_y)(* area3 lst3_y))(+ (+ area1 area2) area3)))
  ;;;;;***********平行移轴定理***********************************
  (setq t1 (abs(- yc LL1)))
  (setq t2 (abs(- yc LL2)))
  (setq t3 (abs(- yc LL3)))
  ;;;;;*********求各个面域惯性矩*********************************
  (setq ix1 (* area1 (* LL1 LL1)))
  (setq ix2 (* area2 (* LL2 LL2)))
  (setq ix3 (* area3 (* LL3 LL3)))
  (setq ix (+ (+ ix1 ix2) ix3))
  (setq ixs (rtos ix))
  ;;;**************取得将各个面域并后的质心**********************
  (princ(strcat "惯性矩的值:    X:" (rtos ix) "\n"))
  (princ(strcat "                     Y:" (rtos iy) "\n"))
  (setq dcl_id (load_dialog "gg"))
  (if (not (new_dialog "gg" dcl_id))   
    (exit)      
  )
  (set_tile "a"ixs )
  (set_tile "b"iys)
  (start_dialog)
  (unload_dialog dcl_id)
  )