有木有能计算重量的LISP.材质与密度需可修改。有木有啊！

lohas1118 · 发表于 2012-8-13 15:43

已经上传副件，有劳各位

lohas1118 · 发表于 2012-8-13 15:56

preone 发表于 2012-8-9 18:26
重量=面积x长度x密度
分别赋值，然后列个公式，就出来了~~
赋值用 setq 函数

你好，我上传图档，你看这个样子可以编个程序吗

preone · 发表于 2012-8-13 19:30

lohas1118 发表于 2012-8-13 15:56
你好，我上传图档，你看这个样子可以编个程序吗

我上传了一张图片，你参考一下，另外，因为是计算价格，对于计算结果的正确与否，你也需要校核一下再用~~

lohas1118 · 发表于 2012-8-14 16:38

preone 发表于 2012-8-13 19:30
我上传了一张图片，你参考一下，另外，因为是计算价格，对于计算结果的正确与否，你也需要校核一下再用~~ ...

你好，我用的是2004版的CAD，输入的参数都是反着的。
第一个数值会跑到最后面，7.85变成.857,20变成了02

命令: tts 输入材料密度(kg/m^3)：.857 输入计算长度或厚度(mm)：02
输入计算面积(mm^2): 选择外框面域或多段线:
选择对象: 找到 1 个

选择对象: 找到 1 个，总计 2 个

选择对象:
逐一选择内部面域或多段线:
选择对象: 找到 1 个

选择对象:

选择对象:
指定输出字高：1
指定插入点:

preone · 发表于 2012-8-14 18:12

本帖最后由 preone 于 2012-8-14 18:20 编辑

lohas1118 发表于 2012-8-14 16:38
你好，我用的是2004版的CAD，输入的参数都是反着的。
第一个数值会跑到最后面，7.85变成.857,20变成了02 ...

这个应该不是程序的问题，你以前输入参数时反着不？还是键盘坏了？

preone · 发表于 2012-8-14 18:48

lohas1118 发表于 2012-8-14 16:38
你好，我用的是2004版的CAD，输入的参数都是反着的。
第一个数值会跑到最后面，7.85变成.857,20变成了02 ...

在网上找了半天也没有找到和你类似的问题呵呵看来你只能重新装cad了
还是你加载了什么反向输出的插件？
对了，上面那个程序有点小bug，我已经在上面的程序里改过来了，你更新一下就好了~~

chlh_jd · 发表于 2012-8-14 22:00

本帖最后由 chlh_jd 于 2012-8-14 22:18 编辑

(defun c:test (/ ss ssen wk a0 l0 a1 l1 str del l p h z en ent is ptl c
pt)
;;by GSLS(SS) 2012-8-14
;;图形面积相减并设置密度和厚度,输出文字
(if (and (setq ss (ssget '((0 . "LWPOLYLINE,ELLIPSE,CIRCLE,SPLINE"))))
(setq ssen (ss2lst ss nil))) ;_选择对象
(if (setq
ssen (vl-remove-if-not
(function
(lambda (x)
(or (vlax-curve-isclosed x)
(equal (vlax-curve-getstartpoint x)
(vlax-curve-getendpoint x)
1e-8))))
ssen)) ;_过滤非封闭曲线
(progn
(setq ssen
(mapcar
(function (lambda (x / l)
(setq l (SS:ClosedCurve:GetPoints x 10))
(if (equal (car l) (last l) 1e-8)
(setq l (cdr l)))
(list (vlax-curve-getarea x) l)))
ssen)) ;_计算曲线面积和坐标表
(setq ssen (vl-sort ssen
(function (lambda (e1 e2)
(> (car e1) (car e2)))))) ;_排序
(setq wk (car ssen)
ssen (cdr ssen)
a0 (car wk)
l0 (cadr wk))
;_减法计算
(if ssen
(foreach a ssen
(setq a1 (car a)
l1 (cadr a))
(if
(not (vl-some (function (lambda (x)
(< (pipl? x l0 1e-8) 0)))
l1))
(setq a0 (- a0 a1)))))
(if
(and
a0
(not (minusp a0))
(not (prompt
"\n输入密度kg/m^3和厚度mm(空格或分号逗号隔开):"))
(setq str (lm:getstring "7850 20"))
(cond ((wcmatch str "* *")
(setq del " "))
((wcmatch str "*;*")
(setq del ";"))
((wcmatch str ",")
)
((setq del "-")))
(setq l (mapcar 'atof (string->strlst str del)))
(setq p (car l))
(setq h (cadr l))
) ;_条件输入
(progn
(setq z (* a0 h p 1e-9))
(setq str (strcat (rtos z 2 3) " kg"))
(setq en (my_entsel "\n选择要修改的文字对象或点:"
(list (cons 0 "TEXT"))
nil))
(setq p (car en))
(if (cadr en)
(entmod (setq ent (entget (cadr en))
ent (subst (cons 1 str) (assoc 1 ent) ent)))
(if (and (setq en
(entmakex (list (cons 0 "TEXT")
(cons 1 str) ;_文字内容
(cons 10 (trans p 1 0)) ;_插入点
(cons 72 0) ;_
(cons 73 1) ;_72 73对正样式,左对齐
(cons 62 256) ;_文字颜色,随层
(cons 40 300.) ;_文字高度
(cons 41 0.7) ;_文字宽度
(cons 50 0.0) ;_文字旋转角度
(cons 7 "STANDARD") ;_文字样式
)))
(setq ent (entget en))
(setq is t))
(while is
(setq ptl (grread t 15 0))
(setq c (car ptl))
(cond
((= c 5)
(setq pt (cadr ptl))
(setq ent (subst (cons 11 pt)
(assoc 11 ent)
ent))
(entmod ent)
(entupd en)
)
((= c 3)
(setq is nil)
)
) ;_cond
) ;_while
) ;_if
) ;_if
(princ (strcat "\n面积与密度换算重量为" str "。"))
) ;_progn
(princ "\n未输入密度和厚度。")
) ;_if
) ;_progn
(princ "\n选择对象类型错误,未包含封闭曲线。")
) ;_if
(princ "\n未选择对象,请重新执行命令。")
) ;_if
(princ)
) ;_defun
;;;配套函数
;;;转换选择集为表
(defun ss2lst (ss vla / a e i)
(if (= (type ss) (quote PICKSET))
(progn
(setq i -1)
(while (setq e (ssname ss (setq i (1+ i))))
(if vla
(setq e (vlax-ename->vla-object e))
nil)
(setq a (cons e a))))
nil))
;;;判断点是否在封闭多边形内 .
;;;Function : judge a point location with polygon
;;;Arg : pt -- a point
;;; pts -- points of polygon
;;; eps -- allowance
;;;return :
;;; -1 -- out of polygon , 0 -- at , 1 -- in
(defun pipl? (pt pts eps / is at a)
;; by 狂刀
;; Edit by GSLS(SS) 2011.03.28
;; Solved the problem : if a point at the given polygon , it perhap return T or NIL .
(if (vl-some (function (lambda (x) (equal x pt eps))) pts)
0
(progn (setq is
(equal
PI
(abs
(apply
(function +)
(mapcar
(function (lambda (x y / a)
(setq a
(rem (- (angle pt x) (angle pt y))
PI))
(if (equal (+ (distance pt x)
(distance pt y))
(distance x y)
Eps)
(setq at T))
a))
(cons (last pts) pts)
pts)))
eps))
(cond (at 0)
(is 1)
(T -1)))))
;;字符串转为表
(defun string->strlst (str del / lst a s1 cha pos i)
(setq s1 ""
i 0
a (ascii del))
(while (setq pos (vl-string-position a str i))
(setq s1 (substr str (1+ i) (- pos i)))
(if (/= s1 "")
(setq lst (cons s1 lst)))
(setq i (1+ pos)))
(setq s1 (substr str (1+ i)))
(if (/= s1 "")
(setq lst (cons s1 lst)))
(reverse lst))
;;封闭曲线取点函数
(defun SS:ClosedCurve:GetPoints (en acc / ent et)
;;by GSLS(SS)
(setq
ent (entget en)
et (cdr (assoc 0 ent)))
(cond
((= et "LWPOLYLINE")
((lambda (/ a b vetex bu p1 p2 l r ang an1 N)
(while (setq ent (member (assoc 10 ent) ent))
(setq b (cons (cdar ent) b)
ent (member (assoc 42 ent) ent)
b (cons (cdar ent) b)
ent (cdr ent)
vetex (cons b vetex)
b nil))
(while vetex
(setq a (car vetex)
vetex (cdr vetex)
bu (car a)
p1 (cadr a))
(if l
(setq p2 (car l))
(setq p2 (cadr (last vetex))))
(if (equal bu 0 1e-6)
(setq l (cons p1 l))
(progn
(setq ang (* 2 (atan bu))
r (/ (distance p1 p2)
(* 2 (sin ang))
)
c (polar p1
(+ (angle p1 p2) (- (/ pi 2) ang))
r
)
r (abs r)
ang (abs (* ang 2.0))
N (abs (fix (/ ang 0.0174532925199433)))
N (min N (1+ Acc)))
(if (= N 0)
(setq l (cons p1 l))
(progn
(setq an1 (/ ang N)
ang (angle c p2)
)
(if (not (minusp bu))
(setq an1 (- an1))
)
(repeat (1- N)
(setq ang (+ ang an1)
l (cons (polar c ang r) l)
)
)
(setq l (cons p1 l)))))))
l)))
((= et "CIRCLE")
((lambda (c R / sa l)
(setq sa 0.0)
(repeat 180
(setq l (cons (polar c sa R) l)
sa (+ sa 0.0174532925199433)))
(setq l (reverse l))
(append
l
(mapcar
(function
(lambda (p)
(mapcar (function +) c (mapcar (function -) c p))))
l
)))
(cdr (assoc 10 ent))
(cdr (assoc 40 ent))))
((= et "SPLINE")
((lambda (/ r _oce)
(setq _oce (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(if (vl-catch-all-apply
(function vl-cmdf)
(list "_PEDIT"
(vlax-vla-object->ename
(vla-copy (vlax-ename->vla-object en))
)
""
acc
""))
(progn
(setq l (ss-assoc 10 (entget (setq r (entlast)))))
(if (vlax-curve-isClosed r)
(setq l (append l (list (car l)))))
(entdel r)))
(setvar "CMDECHO" _oce)
l)))
((= et "ELLIPSE")
((lambda (/ e l _os)
(setq _os (getvar "OSMODE"))
(setvar "OSMODE" 0)
(vl-catch-all-apply
(function vla-offset)
(list (vlax-ename->vla-object en) 0.1))
(setq e (entlast))
(vl-catch-all-apply
(function vla-offset)
(list (vlax-ename->vla-object (entlast)) -0.1))
(entdel e)
(setq e (entlast))
(setq l (ss-assoc 10 (entget e)))
(entdel e)
(setvar "OSMODE" _os)
l)))))
;;
;;;by Lee Mac
(defun LM:GetString (#Default / dcTag result)
(cond ((<= (setq dcTag (load_dialog "ACAD")) 0))
((not (new_dialog "acad_txtedit" dcTag)))
(t
(set_tile "text_edit" #Default)
(action_tile
"accept"
"(setq result (get_tile "text_edit")) (done_dialog)")
(action_tile "cancel" "(done_dialog)")
(start_dialog)
(unload_dialog dcTag)))
result)
;; 【索引表查找】全部
;;;获取表中索引码相同的所有元素
;;;ss-assoc 最快
(defun ss-assoc (a lst / b res)
(while (setq b (assoc a lst))
(setq lst (cdr (member b lst))
res (cons (cdr b) res)
))
(reverse res))
;;
(defun my_entsel
(STR FILTER PRO / PT SS_NAME SS old_modemacro)
(setq old_modemacro (getvar "MODEMACRO"))
(if (/= (type STR) (quote STR))
(progn
(princ "\n变量类型不对，STR应为字符串。\n")
(eval NIL))
(progn
(if (/= (type FILTER) (quote list))
(progn
(princ "\n变量类型不对，FILTER应为表。\n")
(eval NIL))
(progn
(princ STR)
(setvar "MODEMACRO" STR) ;_这里添加选择修改
(setq PT (grread t 4 2)
is_go_on t)
(while (and (/= 3 (car PT))
(/= 11 (car PT))
(/= 25 (car pt))
is_go_on)
(cond
((and (= 2 (car pt))
(or (= 13 (cadr pt)) (= 32 (cadr pt)))) ;_Enter,Space.
(setq is_go_on nil))
((and (= 2 (car pt))
(or (= 115 (cadr pt)) (= 83 (cadr pt)))) ;_S set arg.
(eval pro)
(princ STR))
((and (= 5 (car PT)) (vl-consp (cadr PT)))
(setq SS (ssget (cadr PT) FILTER))
(if SS_NAME
(redraw SS_NAME 4))
(setq SS_NAME NIL)
(if SS
(progn
(setq SS_NAME (ssname SS 0))
(redraw SS_NAME 3))
(setvar "MODEMACRO" old_modemacro)))
) ;_cond
(setq PT (grread t 4 2))
) ;_while
(setvar "MODEMACRO" old_modemacro)
(if (and (/= 11 (car pt)) (/= 25 (car pt)))
(progn
(setq PT (cadr PT))
(setq SS (ssget PT FILTER))
(setvar "LASTPOINT" PT)
(if SS_NAME
(redraw SS_NAME 4)
)
(setq SS_NAME NIL)
(if SS
(progn
(setq SS_NAME (ssname SS 0))
(list (trans PT 1 0) SS_NAME))
(list (trans PT 1 0))))
(if ss_name
(redraw ss_name 4))))))))

(defun c:test  (/ ss ssen wk a0  l0 a1 l1 str del l p h z en ent  is ptl c 
    pt) 
  ;;by GSLS(SS) 2012-8-14 
  ;;图形面积相减并设置密度和厚度,输出文字 
  (if (and (setq ss (ssget '((0 . "LWPOLYLINE,ELLIPSE,CIRCLE,SPLINE")))) 
     (setq ssen (ss2lst ss nil))) ;_选择对象 
    (if  (setq 
    ssen (vl-remove-if-not 
     (function 
       (lambda (x) 
         (or (vlax-curve-isclosed x) 
       (equal  (vlax-curve-getstartpoint x) 
        (vlax-curve-getendpoint x) 
        1e-8)))) 
     ssen)) ;_过滤非封闭曲线 
      (progn 
  (setq ssen 
         (mapcar 
     (function (lambda (x / l) 
           (setq l (SS:ClosedCurve:GetPoints x 10)) 
           (if (equal (car l) (last l) 1e-8) 
             (setq l (cdr l))) 
           (list (vlax-curve-getarea x) l))) 
     ssen)) ;_计算曲线面积和坐标表 
  (setq ssen (vl-sort ssen 
          (function (lambda (e1 e2) 
          (> (car e1) (car e2)))))) ;_排序 
  (setq wk   (car ssen) 
        ssen (cdr ssen) 
        a0   (car wk) 
        l0   (cadr wk)) 
 ;_减法计算 
  (if ssen 
    (foreach a  ssen 
      (setq a1 (car a) 
      l1 (cadr a)) 
      (if 
        (not (vl-some (function (lambda (x) 
          (< (pipl? x l0 1e-8) 0))) 
          l1)) 
         (setq a0 (- a0 a1))))) 
  (if 
    (and 
      a0 
      (not (minusp a0)) 
      (not (prompt 
       "\n输入密度kg/m^3和厚度mm(空格或分号逗号隔开):")) 
      (setq str (lm:getstring "7850 20")) 
      (cond ((wcmatch str "* *") 
       (setq del " ")) 
      ((wcmatch str "*;*") 
       (setq del ";")) 
      ((wcmatch str ",") 
       ) 
      ((setq del "-"))) 
      (setq l (mapcar 'atof (string->strlst str del))) 
      (setq p (car l)) 
      (setq h (cadr l)) 
      ) ;_条件输入 
     (progn 
       (setq z (* a0 h p 1e-9)) 
       (setq str (strcat (rtos z 2 3) " kg")) 
       (setq en (my_entsel "\n选择要修改的文字对象或点:" 
         (list (cons 0 "TEXT")) 
         nil)) 
       (setq p (car en)) 
       (if (cadr en) 
         (entmod (setq ent (entget (cadr en)) 
           ent (subst (cons 1 str) (assoc 1 ent) ent))) 
         (if (and  (setq en 
             (entmakex (list (cons 0 "TEXT") 
                 (cons 1 str) ;_文字内容 
                 (cons 10 (trans p 1 0)) ;_插入点 
                 (cons 72 0) ;_ 
                 (cons 73 1) ;_72 73对正样式,左对齐 
                 (cons 62 256) ;_文字颜色,随层 
                 (cons 40 300.) ;_文字高度 
                 (cons 41 0.7) ;_文字宽度 
                 (cons 50 0.0) ;_文字旋转角度 
                 (cons 7 "STANDARD") ;_文字样式 
                 ))) 
      (setq ent (entget en)) 
      (setq is t)) 
     (while  is 
       (setq ptl (grread t 15 0)) 
       (setq c (car ptl)) 
       (cond 
         ((= c 5) 
          (setq pt (cadr ptl)) 
          (setq ent  (subst (cons 11 pt) 
               (assoc 11 ent) 
               ent)) 
          (entmod ent) 
          (entupd en) 
          ) 
         ((= c 3) 
          (setq is nil) 
          ) 
         ) ;_cond 
       ) ;_while 
     ) ;_if 
         ) ;_if 
       (princ (strcat "\n面积与密度换算重量为" str "。")) 
       ) ;_progn 
     (princ "\n未输入密度和厚度。") 
     ) ;_if 
  ) ;_progn 
      (princ "\n选择对象类型错误,未包含封闭曲线。") 
      ) ;_if 
    (princ "\n未选择对象,请重新执行命令。") 
    ) ;_if 
  (princ) 
  ) ;_defun 
;;;配套函数 
;;;转换选择集为表 
(defun ss2lst  (ss vla / a e i) 
  (if (= (type ss) (quote PICKSET)) 
    (progn 
      (setq i -1) 
      (while (setq e (ssname ss (setq i (1+ i)))) 
  (if vla 
    (setq e (vlax-ename->vla-object e)) 
    nil) 
  (setq a (cons e a)))) 
    nil)) 
;;;判断点是否在封闭多边形内 . 
;;;Function : judge a point location with polygon 
;;;Arg : pt -- a point 
;;;      pts -- points of polygon 
;;;      eps -- allowance 
;;;return : 
;;;     -1 -- out of polygon , 0 -- at , 1 -- in 
(defun pipl?  (pt pts eps / is at a) 
  ;; by 狂刀   
  ;; Edit by GSLS(SS) 2011.03.28 
  ;; Solved the problem : if a point at the given polygon , it perhap return T or NIL .   
  (if (vl-some (function (lambda (x) (equal x pt eps))) pts) 
    0 
    (progn (setq is 
      (equal 
        PI 
        (abs 
          (apply 
      (function +) 
      (mapcar 
        (function (lambda (x y / a) 
              (setq a 
               (rem (- (angle pt x) (angle pt y)) 
              PI)) 
              (if (equal (+ (distance pt x) 
                (distance pt y)) 
             (distance x y) 
             Eps) 
          (setq at T)) 
              a)) 
        (cons (last pts) pts) 
        pts))) 
        eps)) 
     (cond (at 0) 
     (is 1) 
     (T -1))))) 
;;字符串转为表 
(defun string->strlst  (str del / lst a s1 cha pos i) 
  (setq  s1 "" 
  i  0 
  a  (ascii del)) 
  (while (setq pos (vl-string-position a str i)) 
    (setq s1 (substr str (1+ i) (- pos i))) 
    (if  (/= s1 "") 
      (setq lst (cons s1 lst))) 
    (setq i (1+ pos))) 
  (setq s1 (substr str (1+ i))) 
  (if (/= s1 "") 
    (setq lst (cons s1 lst))) 
  (reverse lst)) 
;;封闭曲线取点函数 
(defun SS:ClosedCurve:GetPoints   (en acc / ent et) 
  ;;by GSLS(SS) 
  (setq 
    ent  (entget en) 
    et  (cdr (assoc 0 ent))) 
  (cond 
    ((= et "LWPOLYLINE") 
     ((lambda (/ a b vetex bu p1 p2 l r ang an1 N) 
  (while (setq ent (member (assoc 10 ent) ent)) 
    (setq  b     (cons (cdar ent) b) 
    ent   (member (assoc 42 ent) ent) 
    b     (cons (cdar ent) b) 
    ent   (cdr ent) 
    vetex (cons b vetex) 
    b     nil)) 
  (while vetex 
    (setq  a     (car vetex) 
    vetex (cdr vetex) 
    bu    (car a) 
    p1    (cadr a)) 
    (if l 
      (setq p2 (car l)) 
      (setq p2 (cadr (last vetex)))) 
    (if (equal bu 0 1e-6) 
      (setq l (cons p1 l)) 
      (progn 
        (setq ang  (* 2 (atan bu)) 
        r  (/ (distance p1 p2) 
         (* 2 (sin ang)) 
         ) 
        c  (polar p1 
             (+ (angle p1 p2) (- (/ pi 2) ang)) 
             r 
             ) 
        r  (abs r) 
        ang  (abs (* ang 2.0)) 
        N  (abs (fix (/ ang 0.0174532925199433))) 
        N  (min N (1+ Acc))) 
        (if (= N 0) 
    (setq l (cons p1 l)) 
    (progn 
      (setq  an1 (/ ang N) 
      ang (angle c p2) 
      ) 
      (if (not (minusp bu)) 
        (setq an1 (- an1)) 
        ) 
      (repeat (1- N) 
        (setq ang (+ ang an1) 
        l   (cons (polar c ang r) l) 
        ) 
        ) 
      (setq l (cons p1 l))))))) 
  l))) 
    ((= et "CIRCLE") 
     ((lambda (c R / sa l) 
  (setq sa 0.0) 
  (repeat  180 
    (setq  l  (cons (polar c sa R) l) 
    sa (+ sa 0.0174532925199433))) 
  (setq l (reverse l)) 
  (append 
    l 
    (mapcar 
      (function 
        (lambda (p) 
    (mapcar (function +) c (mapcar (function -) c p)))) 
      l 
      ))) 
       (cdr (assoc 10 ent)) 
       (cdr (assoc 40 ent)))) 
    ((= et "SPLINE") 
     ((lambda (/ r _oce) 
  (setq _oce (getvar "CMDECHO")) 
  (setvar "CMDECHO" 0) 
  (if (vl-catch-all-apply 
        (function vl-cmdf) 
        (list "_PEDIT" 
        (vlax-vla-object->ename 
          (vla-copy (vlax-ename->vla-object en)) 
          ) 
        "" 
        acc 
        "")) 
    (progn 
      (setq l (ss-assoc 10 (entget (setq r (entlast))))) 
      (if  (vlax-curve-isClosed r) 
        (setq l (append l (list (car l))))) 
      (entdel r))) 
  (setvar "CMDECHO" _oce) 
  l))) 
    ((= et "ELLIPSE") 
     ((lambda (/ e l _os) 
  (setq _os (getvar "OSMODE")) 
  (setvar "OSMODE" 0) 
  (vl-catch-all-apply 
    (function vla-offset) 
    (list (vlax-ename->vla-object en) 0.1)) 
  (setq e (entlast)) 
  (vl-catch-all-apply 
    (function vla-offset) 
    (list (vlax-ename->vla-object (entlast)) -0.1)) 
  (entdel e) 
  (setq e (entlast)) 
  (setq l (ss-assoc 10 (entget e))) 
  (entdel e) 
  (setvar "OSMODE" _os) 
  l))))) 
;; 
;;;by Lee Mac 
(defun LM:GetString  (#Default / dcTag result) 
  (cond  ((<= (setq dcTag (load_dialog "ACAD")) 0)) 
  ((not (new_dialog "acad_txtedit" dcTag))) 
  (t 
   (set_tile "text_edit" #Default) 
   (action_tile 
     "accept" 
     "(setq result (get_tile "text_edit")) (done_dialog)") 
   (action_tile "cancel" "(done_dialog)") 
   (start_dialog) 
   (unload_dialog dcTag))) 
  result) 
;; 【索引表查找】全部 
;;;获取表中索引码相同的所有元素 
;;;ss-assoc 最快 
(defun ss-assoc   (a lst / b res) 
  (while (setq b (assoc a lst)) 
    (setq lst (cdr (member b lst)) 
    res (cons (cdr b) res) 
    )) 
  (reverse res)) 
;; 
(defun my_entsel 
      (STR FILTER PRO / PT SS_NAME SS old_modemacro) 
  (setq old_modemacro (getvar "MODEMACRO")) 
  (if (/= (type STR) (quote STR)) 
    (progn 
      (princ "\n变量类型不对，STR应为字符串。\n") 
      (eval NIL)) 
    (progn 
      (if (/= (type FILTER) (quote list)) 
  (progn 
    (princ "\n变量类型不对，FILTER应为表。\n") 
    (eval NIL)) 
  (progn 
    (princ STR) 
    (setvar "MODEMACRO" STR) ;_这里添加选择修改 
    (setq  PT   (grread t 4 2) 
    is_go_on t) 
    (while (and (/= 3 (car PT)) 
          (/= 11 (car PT)) 
          (/= 25 (car pt)) 
          is_go_on) 
      (cond 
        ((and (= 2 (car pt)) 
        (or (= 13 (cadr pt)) (= 32 (cadr pt)))) ;_Enter,Space. 
         (setq is_go_on nil)) 
        ((and (= 2 (car pt)) 
        (or (= 115 (cadr pt)) (= 83 (cadr pt)))) ;_S set arg. 
         (eval pro) 
         (princ STR)) 
        ((and (= 5 (car PT)) (vl-consp (cadr PT))) 
         (setq SS (ssget (cadr PT) FILTER)) 
         (if SS_NAME 
     (redraw SS_NAME 4)) 
         (setq SS_NAME NIL) 
         (if SS 
     (progn 
       (setq SS_NAME (ssname SS 0)) 
       (redraw SS_NAME 3)) 
     (setvar "MODEMACRO" old_modemacro))) 
        ) ;_cond 
      (setq PT (grread t 4 2)) 
      ) ;_while 
    (setvar "MODEMACRO" old_modemacro) 
    (if (and (/= 11 (car pt)) (/= 25 (car pt))) 
      (progn 
        (setq PT (cadr PT)) 
        (setq SS (ssget PT FILTER)) 
        (setvar "LASTPOINT" PT) 
        (if SS_NAME 
    (redraw SS_NAME 4) 
    ) 
        (setq SS_NAME NIL) 
        (if SS 
    (progn 
      (setq SS_NAME (ssname SS 0)) 
      (list (trans PT 1 0) SS_NAME)) 
    (list (trans PT 1 0)))) 
      (if  ss_name 
        (redraw ss_name 4))))))))

longer1000 · 发表于 2012-8-15 09:14

狂刀厉害的

lohas1118 · 发表于 2012-8-15 16:57

完美，如果能指定字高就更完美了！

lohas1118 · 发表于 2012-8-15 17:17

chlh_jd 发表于 2012-8-14 22:00

请教下像这种图形，用这个怎么算不出来。

账号		自动登录	找回密码
密码			注册

有木有能计算重量的LISP.材质与密度需可修改。有木有啊！

本帖子中包含更多资源

点评

点评

本帖子中包含更多资源

点评

评分

本帖子中包含更多资源