求改LEE大师的一个程序。谢谢各位大师了

flytoday · 发表于 2013-2-4 12:12:05

本帖最后由 flytoday 于 2013-2-4 12:30 编辑

;;---------------------=={ Area Label }==---------------------;;
;; ;;
;; Allows the user to label picked areas or objects and ;;
;; either display the area in an ACAD Table (if available), ;;
;; optionally using fields to link area numbers and objects; ;;
;; or write it to file. ;;
;;------------------------------------------------------------;;
;; Author: Lee Mac, Copyright ?2011 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
;; Version 1.9 - 29-10-2011 ;;
;;------------------------------------------------------------;;
(defun c:AT nil (AreaLabel t)) ;; Areas to Table
(defun c:AF nil (AreaLabel nil)) ;; Areas to File
;;------------------------------------------------------------;;
(defun AreaLabel ( flag / *error* _startundo _endundo _centroid _text _open _select _getobjectid _isannotative
 acdoc acspc ap ar as cf cm el fd fl fo n of om p1 pf pt sf st t1 t2 tb th ts tx ucsxang ucszdir )
 ;;------------------------------------------------------------;;
 ;; Adjustments ;;
 ;;------------------------------------------------------------;;
 (setq h1 "面积计算表" ;; Heading
 t1 "编号" ;; Number Title
 t2 "面积" ;; Area Title
 pf "" ;; Number Prefix (optional, "" if none)
 sf "" ;; Number Suffix (optional, "" if none)
 ap "" ;; Area Prefix (optional, "" if none)
 as "" ;; Area Suffix (optional, "" if none)
 cf 1.0 ;; Area Conversion Factor (e.g. 1e-6 = mm2->m2)
 fd t ;; Use fields to link numbers/objects to table (t=yes, nil=no)
 fo "%lu6%qf1" ;; Area field formatting
 )
 ;;------------------------------------------------------------;;
 (defun *error* ( msg )
(if cm (setvar 'CMDECHO cm))
(if el (progn (entdel el) (setq el nil)))
(if acdoc (_EndUndo acdoc))
(if (and of (eq 'FILE (type of))) (close of))
(if (and Shell (not (vlax-object-released-p Shell))) (vlax-release-object Shell))
(if (null (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))
 (princ (strcat "\n--> Error: " msg))
)
(princ)
 )
 ;;------------------------------------------------------------;;
 (defun _StartUndo ( doc ) (_EndUndo doc)
(vla-StartUndoMark doc)
 )
 ;;------------------------------------------------------------;;
 (defun _EndUndo ( doc )
(if (= 8 (logand 8 (getvar 'UNDOCTL)))
 (vla-EndUndoMark doc)
)
 )
 ;;------------------------------------------------------------;;
 (defun _centroid ( space objs / reg cen )
(setq reg (car (vlax-invoke space 'addregion objs))
 cen (vlax-get reg 'centroid)
)
(vla-delete reg) (trans cen 1 0)
 )
 ;;------------------------------------------------------------;;
 (defun _text ( space point string height rotation / text )
(setq text (vla-addtext space string (vlax-3D-point point) height))
(vla-put-alignment text acalignmentmiddlecenter)
(vla-put-textalignmentpoint text (vlax-3D-point point))
(vla-put-rotation text rotation)
text
 )
 ;;------------------------------------------------------------;;
 (defun _Open ( target / Shell result )
(if (setq Shell (vla-getInterfaceObject (vlax-get-acad-object) "Shell.Application"))
 (progn
 (setq result
 (and (or (eq 'INT (type target)) (setq target (findfile target)))
 (not
 (vl-catch-all-error-p
 (vl-catch-all-apply 'vlax-invoke (list Shell 'Open target))
 )
 )
 )
 )
 (vlax-release-object Shell)
 )
)
result
 )
 ;;------------------------------------------------------------;;
 (defun _Select ( msg pred func init / e ) (setq pred (eval pred))
(while
 (progn (setvar 'ERRNO 0) (apply 'initget init) (setq e (func msg))
 (cond
 ( (= 7 (getvar 'ERRNO))
 (princ "\nMissed, try again.")
 )
 ( (eq 'STR (type e))
 nil
 )
 ( (vl-consp e)
 (if (and pred (not (pred (setq e (car e)))))
 (princ "\nInvalid Object Selected.")
 )
 )
 )
 )
)
e
 )
 ;;------------------------------------------------------------;;
 (defun _GetObjectID ( doc obj )
(if (vl-string-search "64" (getenv "PROCESSOR_ARCHITECTURE"))
 (vlax-invoke-method (vla-get-Utility doc) 'GetObjectIdString obj :vlax-false)
 (itoa (vla-get-Objectid obj))
)
 )
 ;;------------------------------------------------------------;;
 (defun _isAnnotative ( style / object annotx )
(and
 (setq object (tblobjname "STYLE" style))
 (setq annotx (cadr (assoc -3 (entget object '("AcadAnnotative")))))
 (= 1 (cdr (assoc 1070 (reverse annotx))))
)
 )

 ;;------------------------------------------------------------;;
 (setq acdoc (vla-get-activedocument (vlax-get-acad-object))
 acspc (vlax-get-property acdoc (if (= 1 (getvar 'CVPORT)) 'Paperspace 'Modelspace))
 ucszdir (trans '(0. 0. 1.) 1 0 t)
 ucsxang (angle '(0. 0. 0.) (trans (getvar 'UCSXDIR) 0 ucszdir))
 )
 (_StartUndo acdoc)
 (setq cm (getvar 'CMDECHO))
 (setvar 'CMDECHO 0)
 (setq om (eq "1" (cond ((getenv "LMAC_AreaLabel")) ((setenv "LMAC_AreaLabel" "0")))))
 (setq ts
(/ (getvar 'TEXTSIZE)
 (if (_isAnnotative (getvar 'TEXTSTYLE))
 (cond ( (getvar 'CANNOSCALEVALUE) ) ( 1.0 )) 1.0
 )
)
 )
 (cond
( (not (vlax-method-applicable-p acspc 'addtable))
 (princ "\n--> Table Objects not Available in this Version.")
)
( (= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (getvar 'CLAYER))))))
 (princ "\n--> Current Layer Locked.")
)
( (not
 (setq *al:num
 (cond
 (
 (getint
 (strcat "\n批定起始编号 <"
 (itoa (setq *al:num (1+ (cond ( *al:num ) ( 0 ))))) ">: "
 )
 )
 )
 ( *al:num )
 )
 )
 )
)
( flag
 (setq th
 (* 2.
 (if
 (zerop
 (setq th
 (vla-gettextheight
 (setq st
 (vla-item
 (vla-item
 (vla-get-dictionaries acdoc) "ACAD_TABLESTYLE"
 )
 (getvar 'CTABLESTYLE)
 )
 )
 acdatarow
 )
 )
 )
 ts
 (/ th
 (if (_isAnnotative (vla-gettextstyle st acdatarow))
 (cond ( (getvar 'CANNOSCALEVALUE) ) ( 1.0 )) 1.0
 )
 )
 )
 )
 )
 (if
 (cond
 (
 (progn (initget "Add")
 (vl-consp (setq pt (getpoint "\n指定表格插入点: ")))
 )
 (setq tb
 (vla-addtable acspc
 (vlax-3D-point (trans pt 1 0)) 2 2 th (* 4 th (max (strlen t1) (strlen t2)))
 )
 )
 (vla-put-direction tb (vlax-3D-point (getvar 'UCSXDIR)))
 (vla-settext tb 0 0 h1)
 (vla-settext tb 1 0 t1)
 (vla-settext tb 1 1 t2)

 (while
 (progn
 (if om
 (setq p1
 (_Select (strcat "\nSelect Object [Pick] <Exit>: ")
 '(lambda ( x )
 (and
 (vlax-property-available-p (vlax-ename->vla-object x) 'area)
 (not (eq "HATCH" (cdr (assoc 0 (entget x)))))
 (or (eq "REGION" (cdr (assoc 0 (entget x)))) (vlax-curve-isclosed x))
 )
 )
 entsel '("Pick")
 )
 )
 (progn (initget "Object") (setq p1 (getpoint "\n点选面积<Exit>: ")))
 )
 (cond
 ( (null p1)
 (vla-delete tb)
 )
 ( (eq "Pick" p1)
 (setq om nil) t
 )
 ( (eq "Object" p1)
 (setq om t)
 )
 ( (eq 'ENAME (type p1))
 (setq tx
 (cons
 (_text acspc
 (_centroid acspc (list (setq p1 (vlax-ename->vla-object p1))))
 (strcat pf (itoa *al:num) sf)
 ts
 ucsxang
 )
 tx
 )
 )
 (vla-insertrows tb (setq n 2) th 1)
 (vla-settext tb n 1
 (if fd
 (strcat "%<\\AcObjProp Object(%<\\_ObjId "
 (_GetObjectID acdoc p1) ">%).Area \\f \"" fo "\">%"
 )
 (strcat ap (rtos (* cf (vla-get-area p1)) 2) as)
 )
 )
 (vla-settext tb n 0
 (if fd
 (strcat "%<\\AcObjProp Object(%<\\_ObjId "
 (_GetObjectID acdoc (car tx)) ">%).TextString>%"
 )
 (strcat pf (itoa *al:num) sf)
 )
 )
 nil
 )
 ( (vl-consp p1)
 (setq el (entlast))
 (vl-cmdf "_.-boundary" "_A" "_I" "_N" "" "_O" "_P" "" "_non" p1 "")
 (if (not (equal el (setq el (entlast))))
 (progn
 (setq tx
 (cons
 (_text acspc
 (_centroid acspc (list (vlax-ename->vla-object el)))
 (strcat pf (itoa *al:num) sf)
 ts
 ucsxang
 )
 tx
 )
 )
 (vla-insertrows tb (setq n 2) th 1)
 (vla-settext tb n 1 (strcat ap (rtos (* cf (vlax-curve-getarea el)) 2) as))
 (vla-settext tb n 0
 (if fd
 (strcat "%<\\AcObjProp Object(%<\\_ObjId "
 (_GetObjectID acdoc (car tx)) ">%).TextString>%"
 )
 (strcat pf (itoa *al:num) sf)
 )
 )
 (redraw el 3)
 nil
 )
 (vla-delete tb)
 )
 )
 )
 )
 )
 (not (vlax-erased-p tb))
 )
 (
 (and
 (setq tb
 (_Select "\nSelect Table to Add to: "
 '(lambda ( x ) (eq "ACAD_TABLE" (cdr (assoc 0 (entget x))))) entsel nil
 )
 )
 (< 1 (vla-get-columns (setq tb (vlax-ename->vla-object tb))))
 )
 (setq n (1- (vla-get-rows tb)) *al:num (1- *al:num))
 )
 )
 (progn
 (while
 (if om
 (setq p1
 (_Select (strcat "\nSelect Object [" (if tx "Undo/" "") "Pick] <Exit>: ")
 '(lambda ( x )
 (and
 (vlax-property-available-p (vlax-ename->vla-object x) 'area)
 (not (eq "HATCH" (cdr (assoc 0 (entget x)))))
 (or (eq "REGION" (cdr (assoc 0 (entget x)))) (vlax-curve-isclosed x))
 )
 )
 entsel (list (if tx "Undo Pick" "Pick"))
 )
 )
 (progn (initget (if tx "Undo Object" "Object"))
 (setq p1 (getpoint (strcat "\n点选面积 [" (if tx "Undo/" "") "Object] <Exit>: ")))
 )
 )
 (cond
 ( (and tx (eq "Undo" p1))
 (if el (progn (entdel el) (setq el nil)))
 (vla-deleterows tb n 1)
 (vla-delete (car tx))
 (setq n (1- n) tx (cdr tx) *al:num (1- *al:num))
 )
 ( (eq "Undo" p1)
 (princ "\n--> Nothing to Undo.")
 )
 ( (eq "Object" p1)
 (if el (progn (entdel el) (setq el nil)))
 (setq om t)
 )
 ( (eq "Pick" p1)
 (setq om nil)
 )
 ( (and om (eq 'ENAME (type p1)))
 (setq tx
 (cons
 (_text acspc
 (_centroid acspc (list (setq p1 (vlax-ename->vla-object p1))))
 (strcat pf (itoa (setq *al:num (1+ *al:num))) sf)
 ts
 ucsxang
 )
 tx
 )
 )
 (vla-insertrows tb (setq n (1+ n)) th 1)
 (vla-settext tb n 1
 (if fd
 (strcat "%<\\AcObjProp Object(%<\\_ObjId "
 (_GetObjectID acdoc p1) ">%).Area \\f \"" fo "\">%"
 )
 (strcat ap (rtos (* cf (vla-get-area p1)) 2) as)
 )
 )
 (vla-settext tb n 0
 (if fd
 (strcat "%<\\AcObjProp Object(%<\\_ObjId "
 (_GetObjectID acdoc (car tx)) ">%).TextString>%"
 )
 (strcat pf (itoa *al:num) sf)
 )
 )
 )
 ( (vl-consp p1)
 (if el (progn (entdel el) (setq el nil)))
 (setq el (entlast))
 (vl-cmdf "_.-boundary" "_A" "_I" "_N" "" "_O" "_P" "" "_non" p1 "")
 (if (not (equal el (setq el (entlast))))
 (progn
 (setq tx
 (cons
 (_text acspc
 (_centroid acspc (list (vlax-ename->vla-object el)))
 (strcat pf (itoa (setq *al:num (1+ *al:num))) sf)
 ts
 ucsxang
 )
 tx
 )
 )
 (vla-insertrows tb (setq n (1+ n)) th 1)
 (vla-settext tb n 1 (strcat ap (rtos (* cf (vlax-curve-getarea el)) 2) as))
 (vla-settext tb n 0
 (if fd
 (strcat "%<\\AcObjProp Object(%<\\_ObjId "
 (_GetObjectID acdoc (car tx)) ">%).TextString>%"
 )
 (strcat pf (itoa *al:num) sf)
 )
 )
 (redraw el 3)
 )
 (princ "\n--> Error Retrieving Area.")
 )
 )
 )
 )
 (if el (progn (entdel el) (setq el nil)))
 )
 )
)
(
 (and
 (setq fl (getfiled "Create Output File" (cond ( *file* ) ( "" )) "txt;csv;xls" 1))
 (setq of (open fl "w"))
 )
 (setq *file* (vl-filename-directory fl)
 de (cdr (assoc (strcase (vl-filename-extension fl) t) '((".txt" . "\t") (".csv" . ",") (".xls" . "\t"))))
 *al:num (1- *al:num)
 )
 (write-line h1 of)
 (write-line (strcat t1 de t2) of)
 (while
 (if om
 (setq p1
 (_Select (strcat "\nSelect Object [Pick] <Exit>: ")
 '(lambda ( x )
 (and
 (vlax-property-available-p (vlax-ename->vla-object x) 'area)
 (not (eq "HATCH" (cdr (assoc 0 (entget x)))))
 (or (eq "REGION" (cdr (assoc 0 (entget x)))) (vlax-curve-isclosed x))
 )
 )
 entsel '("Pick")
 )
 )
 (progn (initget "Object") (setq p1 (getpoint (strcat "\n点选面积: "))))
 )
 (cond
 ( (eq "Object" p1)
 (if el (progn (entdel el) (setq el nil)))
 (setq om t)
 )
 ( (eq "Pick" p1)
 (setq om nil)
 )
 ( (eq 'ENAME (type p1))
 (_text acspc
 (_centroid acspc (list (setq p1 (vlax-ename->vla-object p1))))
 (strcat pf (itoa (setq *al:num (1+ *al:num))) sf)
 ts
 ucsxang
 )
 (write-line (strcat pf (itoa *al:num) sf de ap (rtos (* cf (vla-get-area p1)) 2) as) of)
 )
 ( (vl-consp p1)

 (if el (progn (entdel el) (setq el nil)))
 (setq el (entlast))
 (vl-cmdf "_.-boundary" "_A" "_I" "_N" "" "_O" "_P" "" "_non" p1 "")
 (if (not (equal el (setq el (entlast))))
 (progn
 (_text acspc
 (_centroid acspc (list (vlax-ename->vla-object el)))
 (strcat pf (itoa (setq *al:num (1+ *al:num))) sf)
 ts
 ucsxang
 )
 (write-line (strcat pf (itoa *al:num) sf de ap (rtos (* cf (vlax-curve-getarea el)) 2) as) of)
 (redraw el 3)
 )
 (princ "\n--> Error Retrieving Area.")
 )
 )
 )
 )
 (if el (progn (entdel el) (setq el nil)))
 (setq of (close of))
 (_Open (findfile fl))
)
 )
 (setenv "LMAC_AreaLabel" (if om "1" "0"))
 (setvar 'CMDECHO cm)
 (_EndUndo acdoc)
 (princ)
)
;;------------------------------------------------------------;;
(vl-load-com)
(princ)
(princ "\n:: AreaLabel.lsp | Version 1.9 | ?Lee Mac 2011 www.lee-mac.com ::")
(princ "\n:: Commands: \"AT\" for ACAD Table, \"AF\" for File ::")
(princ)
;;------------------------------------------------------------;;
;; End of File ;;
;;------------------------------------------------------------;;

要求
1、修改mm单位为m保留小数点后三位
2、要求增加一个功能，对形成表格中的文字进行字高设置。。。。。
3、已提取面积的地方生成一个红色线框(这一点有难度就算了哈）
想知道生成的表格高度在哪修改啊。。。还有那个宽度改下两例一起变长变短。能一例一例改长短吗。。。
麻烦各位路过的大师瞧下。。谢谢。。

【KAIXIN】 · 发表于 2013-2-4 13:51:00

这么长，看都要好久呢！
1.修改mm单位为m保留小数点后三位
答：除以1000就好了，小数位数用RTOS

2、要求增加一个功能，对形成表格中的文字进行字高设置。。。。。
答：用程序选到文字，更改高度组码40

3、已提取面积的地方生成一个红色线框(这一点有难度就算了哈）
答：不知道你要什么样的框，框哪里？

【KAIXIN】 · 发表于 2013-2-4 14:25:19

本帖最后由【KAIXIN】于 2013-2-4 14:33 编辑

(XX-PUT-DXF (SSGET) 40 (GETDIST));改文字高度

对于表格，建议用中心缩放文字

(defun c:xx ( / i lts s1 ss)
(setq lts (getdist "缩放比例")
ss (ssget ":s" '((0 . "*TEXT")))
i -1
)
(while (setq s1 (ssname ss (setq i (1+ i))))
(xx-sc s1 (xx-get-s1-9pt s1 5) lts)
)
)
;缩放实体或选择集
;(XX-Sc s1 PO lts) S1为图元名或选择集 PO lts基点与比例
(DEFUN XX-Sc (S1 PO LTS / TP PT I NAME)
(setq tp (type s1) ;提取类型
pt (vlax-3D-point (trans PO 1 0));转成基点
)
(cond
((= tp 'ENAME) (vla-scaleentity (XX-E2O s1) pt lts));XX-E2O 转换为 VLA 对象
((= tp 'PICKSET)
(setq i -1)
(while (setq NAME (ssname s1 (setq i (1+ i))))
(vla-scaleentity (XX-E2O NAME) pt lts);XX-E2O 转换为 VLA 对象
)
)
((= tp 'LIST) (foreach NAME S1 (XX-Sc NAME PO lts)));函数遍历表，将其中每一个元素依次赋给变量，并对每一个表达式求值
(T
(alert "缩放通用函数错了！");都不成立，就打印输入通用函数错了信息
)
)
s1
)
(defun XX-Get-S1-9pt (s1 mode / dx dy point pointmax pointmin x1 x2 y1 y2)
(IF(and (= (type s1) 'ENAME)(= (type mode) 'INT))
(progn
(vla-getboundingbox(XX-E2O s1) 'minpoint 'maxpoint);XX-E2O转为VLA对象
(setq pointmax (vlax-safearray->list maxpoint);取得第9点
pointmin (vlax-safearray->list minpoint);取得第1点
x1 (car pointmin)
x2 (car pointmax)
y1 (cadr pointmin)
y2 (cadr pointmax)
dx (/ (- x2 x1) 2.0)
dy (/ (- y2 y1) 2.0)
)
(cond ((= mode 1) (setq point pointmin))
((= mode 2) (setq point (list (+ x1 dx) y1)))
((= mode 3) (setq point (list x2 y1)))
((= mode 4) (setq point (list x1 (+ y1 dy))))
((= mode 5) (setq point (list (+ x1 dx) (+ y1 dy))))
((= mode 6) (setq point (list x2 (+ y1 dy))))
((= mode 7) (setq point (list x1 y2)))
((= mode 8) (setq point (list (+ x1 dx) y2)))
((= mode 9) (setq point pointmax))
(t (setq point pointmin))
)
point
)
(alert "指定图元最小外接矩形的九点坐标，通用函数错了！")
)
)

(defun c:xx ( / i lts s1 ss) 
  (setq lts (getdist "缩放比例") 
 ss (ssget ":s" '((0 . "*TEXT"))) 
 i -1 
  ) 
  (while (setq s1 (ssname ss (setq i (1+ i)))) 
    (xx-sc s1 (xx-get-s1-9pt s1 5) lts) 
  ) 
) 
;缩放实体或选择集 
;(XX-Sc s1 PO lts) S1为图元名或选择集  PO lts基点与比例 
(DEFUN XX-Sc (S1 PO LTS / TP PT I NAME) 
    (setq tp (type s1) ;提取类型 
          pt (vlax-3D-point (trans PO 1 0));转成基点 
    ) 
 (cond 
   ((= tp 'ENAME) (vla-scaleentity (XX-E2O s1) pt lts));XX-E2O 转换为 VLA 对象 
   ((= tp 'PICKSET) 
      (setq i -1) 
    (while (setq NAME (ssname s1 (setq i (1+ i)))) 
      (vla-scaleentity (XX-E2O NAME) pt lts);XX-E2O 转换为 VLA 对象 
    ) 
   ) 
   ((= tp 'LIST) (foreach NAME S1 (XX-Sc NAME PO lts)));函数遍历表，将其中每一个元素依次赋给变量，并对每一个表达式求值 
   (T 
    (alert "缩放 通用函数错了！");都不成立，就打印输入通用函数错了信息 
   ) 
 ) 
  s1 
) 
 
(defun XX-Get-S1-9pt (s1 mode / dx dy point pointmax pointmin x1 x2 y1 y2) 
 (IF(and (= (type s1) 'ENAME)(= (type mode) 'INT)) 
  (progn 
    (vla-getboundingbox(XX-E2O s1) 'minpoint 'maxpoint);XX-E2O转为VLA对象 
   (setq pointmax (vlax-safearray->list maxpoint);取得第9点 
         pointmin (vlax-safearray->list minpoint);取得第1点 
              x1  (car pointmin) 
              x2  (car pointmax) 
              y1  (cadr pointmin) 
              y2  (cadr pointmax) 
              dx  (/ (- x2 x1) 2.0) 
              dy  (/ (- y2 y1) 2.0) 
   ) 
   (cond ((= mode 1) (setq point pointmin)) 
         ((= mode 2) (setq point (list (+ x1 dx) y1))) 
         ((= mode 3) (setq point (list x2 y1))) 
         ((= mode 4) (setq point (list x1 (+ y1 dy)))) 
         ((= mode 5) (setq point (list (+ x1 dx) (+ y1 dy)))) 
         ((= mode 6) (setq point (list x2 (+ y1 dy)))) 
         ((= mode 7) (setq point (list x1 y2))) 
         ((= mode 8) (setq point (list (+ x1 dx) y2))) 
         ((= mode 9) (setq point pointmax)) 
         (t (setq point pointmin)) 
   ) 
   point 
  ) 
  (alert "指定图元最小外接矩形的九点坐标，通用函数错了！") 
 ) 
)

cable2004 · 发表于 2013-2-4 16:43:20

本帖最后由 cable2004 于 2013-2-4 16:45 编辑

版本太低，调试不了这个程序，粗略看了一下。你试试
1 面积 (strcat ap (rtos (* cf (vla-get-area p1)) 2) as)改前面  cf 0.001

2 ts 字的高度  (setq ts
(/ (getvar 'TEXTSIZE)
   (if (_isAnnotative (getvar 'TEXTSTYLE))
      (cond ( (getvar 'CANNOSCALEVALUE) ) ( 1.0 )) 1.0
   )
)
  )

flytoday · 发表于 2013-2-4 17:09:20

只要把两边的例设置成不一样宽度就好了。。。

麻烦哪位大师瞧下谢谢~

cable2004 · 发表于 2013-2-4 18:01:37

本帖最后由 cable2004 于 2013-2-4 18:21 编辑

我的cad版本太低，调试不了，你自己试试吧！
(setq tb
            (vla-addtable acspc
            (vlax-3D-point (trans pt 1 0)) 2 2 th (* 0.8 th (max (strlen t1) (strlen t2)))
            )
         )

表格的高 th 宽 (* 0.8 th (max (strlen t1) (strlen t2)))

3、已提取面积的地方生成一个红色线框(这一点有难度就算了哈）
(not (equal el (setq el (entlast))))
(vlax-ename->vla-object el)
求BOX点就好。

flytoday · 发表于 2013-2-5 10:09:20

哇沉滴好快…………顶起来

flytoday · 发表于 2013-2-5 17:11:20

哇沉滴好快…………顶起来
回复编辑

flytoday · 发表于 2013-2-6 16:22:15

各位大师…麻烦改下嘛谢谢啦

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

求改LEE大师的一个程序。谢谢各位大师了

相关帖子

点评

评分

点评

本帖子中包含更多资源

评分