为什么CAD2009用ENTMAKE做INSERT,属性跟随ATTRIB

树櫴希德 · 发表于 2014-9-20 09:10:23

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

为什么CAD2009用ENTMAKE做INSERT,属性跟随ATTRIB有3个，在CAD2004测试就可以，在CAD2009就出不来？连块都做不出来？
;40后是文字高，D后是行距
(gc)
(defun gxl-cs:gcd (inspt height scale height2 height3 height4 / pt blkdef obj);展高程点函数(inspt:插入点,heitht:高程值,scale:缩放比例,xsws:高程注记位数)
  (setvar "CMDECHO" 0)
  (command "layer" "m" "tfzj" "c" "1" "" "L" "CONTINUOUS" ""  "")
  ;(if height
;(setq height (rtos height 2 3));3为高程注记位数
;(setq height "")
  ;)
  (regapp "SOUTH")

  ;;;检查字体 "HZ" 是否存在
  (if (not (tblobjname "style" "HZ"))
(command "style" "HZ" "rs.shx,hztxt.shx" 0 1 0 "" "" "")
  )
  ;;;检查是否存在高程点图块定义
  (if (not (tblobjname "block" "GC200"))
(progn
   (setq blkdef (vla-Add (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))) (vlax-3D-point '(0 0 0)) "GC200"))
   (setq obj
      (vla-AddPolyline
         blkdef
         (vlax-make-variant
            (vlax-safearray-fill
               (vlax-make-safearray vlax-vbdouble (cons 0 5))
               '(-0.2 0 0 0.2 0 0)
            )
         )
      )
   )
   (vla-SetBulge obj 0 1) (vla-SetBulge obj 1 1)
   (vla-put-Closed obj :vlax-true)
   (vla-put-ConstantWidth obj 0.4)
)
  )
  ;;;插入块
  (entmake (list
         '(0 . "INSERT")
         '(100 . "AcDbEntity")
         '(100 . "AcDbBlockReference")
         '(66 . 1);;;属性跟随标志,1跟随，0不跟随
            (cons 2 "GC200")
            (cons 10 inspt)
            (cons 41 scale)
            (cons 42 scale)
            (cons 43 scale)
            (list -3 '("SOUTH" (1000 . "951495418")))
         )
  )
  ;;;插入属性
  (entmake (list
         '(0 . "ATTRIB")
         '(100 . "AcDbEntity")
         '(100 . "AcDbText")
            (cons 10 (setq pt (polar inspt 0 (* 1.2 scale))))
            (cons 40 (* 2.0 scale))
            (cons 50 0)
            (cons 41 0.8)
            (cons 51 0)
            (cons 1 height)
            (cons 7 "HZ")
            (cons 72 2)
            (cons 11 pt)
            '(100 . "AcDbAttribute")
            (cons 2 "height")
            (cons 70  0)
            (cons 74 1)
         )
)
;;;;;;;;
  (entmake (list
         '(0 . "ATTRIB")
         '(100 . "AcDbEntity")
         '(100 . "AcDbText")
      (cons 62 2)
            (cons 10 pt)
            (cons 40 (* 2.0 scale))
            (cons 50 0)
            (cons 41 0.8)
            (cons 51 0)
            (cons 1 height2)
            (cons 7 "HZ")
            (cons 72 0)
            (cons 11 pt)
            '(100 . "AcDbAttribute")
            (cons 2 "height2")
            (cons 70  0)
            (cons 74 3)
         ))
  ;;;;;;;;;;;;
  (entmake (list
         '(0 . "ATTRIB")
         '(100 . "AcDbEntity")
         '(100 . "AcDbText")
      (cons 62 3)
            (cons 10 pt)
            (cons 40 (* 2.0 scale))
            (cons 50 0)
            (cons 41 0.8)
            (cons 51 0)
            (cons 1 height3)
            (cons 7 "HZ")
            (cons 72 0)
      (cons 73 2)
            (cons 11 pt)
            '(100 . "AcDbAttribute")
            (cons 2 "height3")
            (cons 70  0)
            (cons 74 1)
         ))
  ;;;;;;
(entmake (list
         '(0 . "ATTRIB")
         '(100 . "AcDbEntity")
         '(100 . "AcDbText")
      (cons 62 3)
            (cons 10 (setq pzx0 (polar pt (* 1.5 pi) (* 2 scale))))
            (cons 40 (* 2.0 scale))
            (cons 50 0)
            (cons 41 0.8)
            (cons 51 0)
            (cons 1 height4)
            (cons 7 "HZ")
            (cons 72 0)
      (cons 73 2)
            (cons 11 pzx0)
            '(100 . "AcDbAttribute")
            (cons 2 "height4")
            (cons 70  0)
            (cons 74 3)
         ))
;;;结束标志
  (entmake '((0 . "SEQEND")
         (100 . "AcDbEntity")
         (67 . 0)
         (410 . "Model")
         (8 . "0")
         )
  )
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:pzx (/                str->pt    _mktext       fl
         lst       nl          _pi2       _3pi
         d                _Pnts:Center                _List:FromFile
         String:Split
         )

(setq blc (getint "\n请输入比例尺1:"))
  (setvar 'userr1 blc);设置比例尺
  ;(setq zg (* 0.002 blc));字高
  (setq scale (* 0.001 blc));缩放比例



  (defun String:Split (str delimiter / post strlst stl)
(if       str
   (progn
      (setq stl (strlen delimiter))
      (while (vl-string-search delimiter str)
      (setq       post (vl-string-search delimiter str)
            strlst (cons (substr str 1 post) strlst)
            str (substr str (+ 1 post stl))
      )
      )
      (reverse (vl-remove "" (cons str strlst)))
   )
)
  )
  (defun _List:FromFile       (fn / f l ll)
(if       (setq f (open (findfile fn) "r"))
   (progn
      (while (setq l (read-line f))
      (setq ll (cons l ll))
      )
      (close f)
   )
)
ll
  )
  (defun XD::Pnt:SetZ (p z)
(list (car p) (cadr p) z)
  )
  (defun str->pt (str)
(XD::Pnt:SetZ
   (mapcar 'distof (cdr (String:Split str ",")))
   0.
)
  )
  (defun _Pnts:Center (p1 p2 p3 /)
(mapcar '(lambda (x y z)
            (/ (+ x y z) 3.)
         )
         p1
         p2
         p3
)
  )
  (defun _mktext (p str / txt)
(entmake (list '(0 . "Text")
               '(100 . "AcDbEntity")
               '(100 . "AcDbText")
               (cons 1 str)
               (cons 10 p)
               '(40 . 0.1)
               '(50 . 0.0)
               '(41 . 1.0)
               (cons 7 (getvar "textstyle"))
               '(71 . 0)
               '(72 . 4)
               (cons 11 p)
               '(73 . 1)
         )
)
  )
;;;;;;;
(defun getplarea (l)
  (* 0.5
   (apply
   '+
   (mapcar
      '(lambda (a b) (- (* (car a) (cadr b)) (* (car b) (cadr a))))
      l
      (append (cdr l) (list (car l)))
   )
   )
  )
)
;;;;;;;
  (if (setq fl (getfiled "Select Log file" "" "log" 8))
(progn
   (setq lst       (_List:FromFile fl)
         _pi2 (* pi 0.5)
         _3pi (- _pi2)
         d       0.1
   )
   (while lst
      (setq nl  (cons       (list (car lst)
                           (cadr lst)
                           (caddr lst)
                           (nth 3 lst)
                           (nth 4 lst)
                     )
                     nl
               )
            lst (cddr (cddddr lst))
      )
   )
(mapcar '(lambda (x / p bh ll )
               (setq p  (_Pnts:Center
                        (setq pa (str->pt (cadr x)))
                        (setq pb (str->pt (caddr x)))
                        (setq pc (str->pt (cadddr x)))
                        )
                     bh (substr (last x) 7)
                     ll (vl-remove "" (String:Split (car x) " "))
               )
               (_mktext (polar p _pi2 d) bh)
               (_mktext p (strcat (car ll) (cadr ll)))
               (_mktext (polar p _3pi d) (strcat (caddr ll) (last ll)))
               (_mktext (polar p _3pi (* 2 d)) (strcat "面积:" (rtos (abs (getplarea (list pa pb pc))) 2 3)))
               (gxl-cs:gcd p bh scale (strcat (car ll) (cadr ll)) (strcat (caddr ll) (last ll)) (strcat "面积:" (rtos (abs (getplarea (list pa pb pc))) 2 3)))
            )
            nl
   )


)
  )
  (princ)
)

树櫴希德 · 发表于 2014-9-20 09:49:15

上面那个是测试文件

Free-Lancer · 发表于 2014-9-20 10:25:04

树櫴希德发表于 2014-9-20 09:49
上面那个是测试文件

entmake 太长了，添加属性用 vla-addattribute blkdef

xdata 是在 insert 后添加的

树櫴希德 · 发表于 2014-9-20 10:36:45

关键是为什么2004可以 2009就不行啊

Free-Lancer · 发表于 2014-9-20 10:50:08

本帖最后由 Free-Lancer 于 2014-9-20 10:52 编辑

树櫴希德发表于 2014-9-20 10:36
关键是为什么2004可以 2009就不行啊

只能说 Autocad 越来越规范了，以前要求比较松
2004 下可以用非属性块，Insert 后再 entmake 属性跟随，CASS 原来一直这样干
可能高版本不允许这样了，只能把属性做到块定义内部

树櫴希德 · 发表于 2014-9-20 10:59:49

cass9.1也是这样干的啊

树櫴希德 · 发表于 2014-9-20 11:05:44

如果跟随只有一个，就行，多于1个，就不行，但是跟DXF帮助对不上啊

Free-Lancer · 发表于 2014-9-20 11:16:27

树櫴希德发表于 2014-9-20 10:59
cass9.1也是这样干的啊

还是把属性写入块内，在外部不能直接 Explode

(gc)
(defun MakeGcd
(inspt height scale height2 height3 height4 / pt blkdef obj)
(setvar "CMDECHO" 0)
(command "layer" "m" "tfzj" "c" "1" "" "L" "CONTINUOUS" "" "")
(regapp "SOUTH")
;;检查字体 "HZ" 是否存在
(if (not (tblobjname "style" "HZ"))
(command "style" "HZ" "rs.shx,hztxt.shx" 0 1 0 "" "" "")
)
;;检查是否存在高程点图块定义
(if (not (tblobjname "block" "GC200"))
(progn
(setq blkdef
(vla-Add (fy:acblocks)
(vlax-3D-point '(0 0 0))
"GC200"
)
obj
(vla-AddPolyline
blkdef
(list->variantarray
'(-0.2 0 0 0.2 0 0)
vlax-vbdouble
)
)
)
(vla-SetBulge obj 0 1)
(vla-SetBulge obj 1 1)
(vla-put-Closed obj :vlax-true)
(vla-put-ConstantWidth obj 0.4)
;;Height, Mode, Prompt, InsertionPoint, Tag, Value
(vla-addattribute
blkdef
height
acAttributeModePreset
"height1"
(vlax-3d-point '(1.2 0. 0.))
"height1"
""
)
(vla-addattribute
blkdef
height
acAttributeModePreset
"height2"
(vlax-3d-point '(2. 0. 0.))
"height2"
""
)
(vla-addattribute
blkdef
height
acAttributeModePreset
"height3"
(vlax-3d-point '(1.2 1.2 0.))
"height3"
""
);_可以在调整对齐方式
)
)
;;InsertionPoint, Name, Xscale, Yscale, ZScale, Rotation [, Password
(setq blkref (vla-insertblock
(fy:acspace)
(vlax-3d-point inspt)
"GC200"
scale
scale
scale
0.
)
atts (vlax-invoke blkref 'Getattributes)
)
(vla-put-textstring (car atts) height2)
(vla-put-textstring (cadr atts) height3)
(vla-put-textstring (last atts) height4)
(entmod (append (entget (entlast))
(list '(-3 '("SOUTH" (1000 . "951495418"))))
)
)
)

(gc) 
(defun MakeGcd 
       (inspt height scale height2 height3 height4 / pt blkdef obj) 
  (setvar "CMDECHO" 0) 
  (command "layer" "m" "tfzj" "c" "1" "" "L" "CONTINUOUS" "" "") 
  (regapp "SOUTH") 
  ;;检查字体 "HZ" 是否存在 
  (if (not (tblobjname "style" "HZ")) 
    (command "style" "HZ" "rs.shx,hztxt.shx" 0 1 0 "" "" "") 
  ) 
  ;;检查是否存在高程点图块定义 
  (if (not (tblobjname "block" "GC200")) 
    (progn 
      (setq blkdef 
                   (vla-Add (fy:acblocks) 
                            (vlax-3D-point '(0 0 0)) 
                            "GC200" 
                   ) 
            obj 
                   (vla-AddPolyline 
                     blkdef 
                     (list->variantarray 
                       '(-0.2 0 0 0.2 0 0) 
                       vlax-vbdouble 
                     ) 
                   ) 
      ) 
      (vla-SetBulge obj 0 1) 
      (vla-SetBulge obj 1 1) 
      (vla-put-Closed obj :vlax-true) 
      (vla-put-ConstantWidth obj 0.4) 
      ;;Height, Mode, Prompt, InsertionPoint, Tag, Value 
      (vla-addattribute 
        blkdef 
        height 
        acAttributeModePreset 
        "height1" 
        (vlax-3d-point '(1.2 0. 0.)) 
        "height1" 
        "" 
      ) 
      (vla-addattribute 
        blkdef 
        height 
        acAttributeModePreset 
        "height2" 
        (vlax-3d-point '(2. 0. 0.)) 
        "height2" 
        "" 
      ) 
      (vla-addattribute 
        blkdef 
        height 
        acAttributeModePreset 
        "height3" 
        (vlax-3d-point '(1.2 1.2 0.)) 
        "height3" 
        "" 
      );_可以在调整对齐方式 
    ) 
  ) 
  ;;InsertionPoint, Name, Xscale, Yscale, ZScale, Rotation [, Password 
  (setq        blkref (vla-insertblock 
                 (fy:acspace) 
                 (vlax-3d-point inspt) 
                 "GC200" 
                 scale 
                 scale 
                 scale 
                 0. 
               ) 
        atts   (vlax-invoke blkref 'Getattributes) 
  ) 
  (vla-put-textstring (car atts) height2) 
  (vla-put-textstring (cadr atts) height3) 
  (vla-put-textstring (last atts) height4) 
  (entmod (append (entget (entlast)) 
                  (list '(-3 '("SOUTH" (1000 . "951495418")))) 
          ) 
  ) 
)

树櫴希德 · 发表于 2014-9-20 14:18:29

这种写法好复杂啊，大神

Free-Lancer · 发表于 2014-9-20 14:55:28

树櫴希德发表于 2014-9-20 14:18
这种写法好复杂啊，大神

自己整理整理就不复杂了，Blockdef blockref Attribute 还是 Vla 方便

(defun MakeGcd (inspt height scale height2 height3
height4 / addattribute pt
blkdef obj
)
;;((blkdef height prompt point tag)..)
(defun addattribute (lst /)
(mapcar '(lambda (x)
(vla-addattribute
(car x)
(cadr x)
acAttributeModePreset
(caddr x)
(vlax-3d-point (cadddr x))
(last x)
""
)
)
lst
)
)
(setvar "CMDECHO" 0)
(command "layer" "m" "tfzj" "c" "1" "" "L" "CONTINUOUS" "" "")
(regapp "SOUTH")
;;检查字体 "HZ" 是否存在
(if (not (tblobjname "style" "HZ"))
(command "style" "HZ" "rs.shx,hztxt.shx" 0 1 0 "" "" "")
)
;;检查是否存在高程点图块定义
(if (not (tblobjname "block" "GC200"))
(progn
(setq blkdef (vla-Add (fy:acblocks)
(vlax-3D-point '(0 0 0))
"GC200"
)
obj (vla-AddPolyline
blkdef
(list->variantarray
'(-0.2 0 0 0.2 0 0)
vlax-vbdouble
)
)
)
(vla-SetBulge obj 0 1)
(vla-SetBulge obj 1 1)
(vla-put-Closed obj :vlax-true)
(vla-put-ConstantWidth obj 0.4)
(addattribute
(list (list blkdef height "height1" '(1.2 0. 0.) "height1")
(list blkdef height "height2" '(2.0 0. 0.) "height2")
(list blkdef height "heihgt3" '(1.2 1.2 0.) "height3")
)
)
)
)
;;InsertionPoint, Name, Xscale, Yscale, ZScale, Rotation
(setq blkref (vla-insertblock
(fy:acspace)
(vlax-3d-point inspt)
"GC200"
scale
scale
scale
0.
)
)
(mapcar '(lambda (x y)
(vla-put-textstring x y)
)
(vlax-invoke blkref 'Getattributes)
(list height2 height3 height4)
)
(entmod (append (entget (entlast))
(list '(-3 '("SOUTH" (1000 . "951495418"))))
)
)
)

(defun MakeGcd (inspt          height    scale     height2        height3 
                height4          /            addattribute        pt 
                blkdef          obj 
               ) 
  ;;((blkdef height prompt point tag)..) 
  (defun addattribute (lst /) 
    (mapcar '(lambda (x) 
               (vla-addattribute 
                 (car x) 
                 (cadr x) 
                 acAttributeModePreset 
                 (caddr x) 
                 (vlax-3d-point (cadddr x)) 
                 (last x) 
                 "" 
               ) 
             ) 
            lst 
    ) 
  ) 
  (setvar "CMDECHO" 0) 
  (command "layer" "m" "tfzj" "c" "1" "" "L" "CONTINUOUS" "" "") 
  (regapp "SOUTH") 
  ;;检查字体 "HZ" 是否存在 
  (if (not (tblobjname "style" "HZ")) 
    (command "style" "HZ" "rs.shx,hztxt.shx" 0 1 0 "" "" "") 
  ) 
  ;;检查是否存在高程点图块定义 
  (if (not (tblobjname "block" "GC200")) 
    (progn 
      (setq blkdef (vla-Add (fy:acblocks) 
                            (vlax-3D-point '(0 0 0)) 
                            "GC200" 
                   ) 
            obj           (vla-AddPolyline 
                     blkdef 
                     (list->variantarray 
                       '(-0.2 0 0 0.2 0 0) 
                       vlax-vbdouble 
                     ) 
                   ) 
      ) 
      (vla-SetBulge obj 0 1) 
      (vla-SetBulge obj 1 1) 
      (vla-put-Closed obj :vlax-true) 
      (vla-put-ConstantWidth obj 0.4) 
      (addattribute 
        (list (list blkdef height "height1" '(1.2 0. 0.) "height1") 
              (list blkdef height "height2" '(2.0 0. 0.) "height2") 
              (list blkdef height "heihgt3" '(1.2 1.2 0.) "height3") 
        ) 
      ) 
    ) 
  ) 
  ;;InsertionPoint, Name, Xscale, Yscale, ZScale, Rotation 
  (setq        blkref (vla-insertblock 
                 (fy:acspace) 
                 (vlax-3d-point inspt) 
                 "GC200" 
                 scale 
                 scale 
                 scale 
                 0. 
               ) 
  ) 
  (mapcar '(lambda (x y) 
             (vla-put-textstring x y) 
           ) 
          (vlax-invoke blkref 'Getattributes) 
          (list height2 height3 height4) 
  ) 
  (entmod (append (entget (entlast)) 
                  (list '(-3 '("SOUTH" (1000 . "951495418")))) 
          ) 
  ) 
)

树櫴希德 · 发表于 2014-9-20 15:27:35

; 错误: no function definition: FY:ACSPACE还缺少文件

newer · 发表于 2014-9-20 15:35:51

树櫴希德发表于 2014-9-20 15:27
; 错误: no function definition: FY:ACSPACE还缺少文件

自己搜索下论坛不就有了

QQ截图20140920153537.png

树櫴希德 · 发表于 2014-9-20 15:38:39

x谢谢版主指点

树櫴希德 · 发表于 2014-9-20 15:58:07

(gc)
(vl-load-com)
;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun fy:acspace nil
  (if (zerop (getvar "tilemode"))
(vla-get-paperspace (fy:acdoc))
(fy:acms)
  )
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun FY:acMs nil
  (eval       (list 'defun
            'FY:acMs
            'nil
            (vla-get-modelspace (FY:acdoc))
      )
  )
  (FY:acMs)
)
;;;;;;;;;;;;;;;;;;;;;;;;;
(defun Fy:acDoc       nil
  (eval       (list 'defun
            'FY:acdoc
            'nil
            (vla-get-activedocument (vlax-get-acad-object))
      )
  )
  (fy:acdoc)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun MakeGcd (inspt       height scale    height2       height3
            height4       /          addattribute       pt
            blkdef       obj
            )
  ;;((blkdef height prompt point tag)..)
  (defun addattribute (lst /)
(mapcar '(lambda (x)
            (vla-addattribute
               (car x)
               (cadr x)
               acAttributeModePreset
               (caddr x)
               (vlax-3d-point (cadddr x))
               (last x)
               ""
            )
         )
         lst
)
  )
  (setvar "CMDECHO" 0)
  (command "layer" "m" "tfzj" "c" "1" "" "L" "CONTINUOUS" "" "")
  (regapp "SOUTH")
  ;;检查字体 "HZ" 是否存在
  (if (not (tblobjname "style" "HZ"))
(command "style" "HZ" "rs.shx,hztxt.shx" 0 1 0 "" "" "")
  )
  ;;检查是否存在高程点图块定义
  (if (not (tblobjname "block" "GC200"))
(progn
   (setq blkdef (vla-Add (fy:acblocks)
                        (vlax-3D-point '(0 0 0))
                        "GC200"
               )
         obj          (vla-AddPolyline
                  blkdef
                  (list->variantarray
                     '(-0.2 0 0 0.2 0 0)
                     vlax-vbdouble
                  )
               )
   )
   (vla-SetBulge obj 0 1)
   (vla-SetBulge obj 1 1)
   (vla-put-Closed obj :vlax-true)
   (vla-put-ConstantWidth obj 0.4)
   (addattribute
      (list (list blkdef height "height1" '(1.2 0. 0.) "height1")
            (list blkdef height "height2" '(2.0 0. 0.) "height2")
            (list blkdef height "heihgt3" '(1.2 1.2 0.) "height3")
      )
   )
)
  )
  ;;InsertionPoint, Name, Xscale, Yscale, ZScale, Rotation
  (setq       blkref (vla-insertblock
               (fy:acspace)
               (vlax-3d-point inspt)
               "GC200"
               scale
               scale
               scale
               0.
            )
  )
  (mapcar '(lambda (x y)
         (vla-put-textstring x y)
         )
      (vlax-invoke blkref 'Getattributes)
      (list height2 height3 height4)
  )
  (entmod (append (entget (entlast))
               (list (list -3 '("SOUTH" (1000 . "951495418"))))
      )
  )
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:pzx (/                str->pt    _mktext       fl
         lst       nl          _pi2       _3pi
         d                _Pnts:Center                _List:FromFile
         String:Split
         )

(setq blc (getint "\n请输入比例尺1:"))
  (setvar 'userr1 blc);设置比例尺
  ;(setq zg (* 0.002 blc));字高
  (setq scale (* 0.001 blc));缩放比例

  (defun String:Split (str delimiter / post strlst stl)
(if       str
   (progn
      (setq stl (strlen delimiter))
      (while (vl-string-search delimiter str)
      (setq       post (vl-string-search delimiter str)
            strlst (cons (substr str 1 post) strlst)
            str (substr str (+ 1 post stl))
      )
      )
      (reverse (vl-remove "" (cons str strlst)))
   )
)
  )
  (defun _List:FromFile       (fn / f l ll)
(if       (setq f (open (findfile fn) "r"))
   (progn
      (while (setq l (read-line f))
      (setq ll (cons l ll))
      )
      (close f)
   )
)
ll
  )
  (defun XD::Pnt:SetZ (p z)
(list (car p) (cadr p) z)
  )
  (defun str->pt (str)
(XD::Pnt:SetZ
   (mapcar 'distof (cdr (String:Split str ",")))
   0.
)
  )
  (defun _Pnts:Center (p1 p2 p3 /)
(mapcar '(lambda (x y z)
            (/ (+ x y z) 3.)
         )
         p1
         p2
         p3
)
  )
  (defun _mktext (p str / txt)
(entmake (list '(0 . "Text")
               '(100 . "AcDbEntity")
               '(100 . "AcDbText")
               (cons 1 str)
               (cons 10 p)
               '(40 . 0.1)
               '(50 . 0.0)
               '(41 . 1.0)
               (cons 7 (getvar "textstyle"))
               '(71 . 0)
               '(72 . 4)
               (cons 11 p)
               '(73 . 1)
         )
)
  )
;;;;;;;
(defun getplarea (l)
  (* 0.5
   (apply
   '+
   (mapcar
      '(lambda (a b) (- (* (car a) (cadr b)) (* (car b) (cadr a))))
      l
      (append (cdr l) (list (car l)))
   )
   )
  )
)
;;;;;;;
  (if (setq fl (getfiled "Select Log file" "" "log" 8))
(progn
   (setq lst       (_List:FromFile fl)
         _pi2 (* pi 0.5)
         _3pi (- _pi2)
         d       0.1
   )
   (while lst
      (setq nl  (cons       (list (car lst)
                           (cadr lst)
                           (caddr lst)
                           (nth 3 lst)
                           (nth 4 lst)
                     )
                     nl
               )
            lst (cddr (cddddr lst))
      )
   )
(mapcar '(lambda (x / p bh ll )
               (setq p  (_Pnts:Center
                        (setq pa (str->pt (cadr x)))
                        (setq pb (str->pt (caddr x)))
                        (setq pc (str->pt (cadddr x)))
                        )
                     bh (substr (last x) 7)
                     ll (vl-remove "" (String:Split (car x) " "))
               )
               (_mktext (polar p _pi2 d) bh)
               (_mktext p (strcat (car ll) (cadr ll)))
               (_mktext (polar p _3pi d) (strcat (caddr ll) (last ll)))
               (_mktext (polar p _3pi (* 2 d)) (strcat "面积:" (rtos (abs (getplarea (list pa pb pc))) 2 3)))
               (MakeGcd p bh scale (strcat (car ll) (cadr ll)) (strcat (caddr ll) (last ll)) (strcat "面积:" (rtos (abs (getplarea (list pa pb pc))) 2 3)))
            )
            nl
   )

)
  )
  (princ)
)

把高程点终于展出来了，就是没有其他数据？

Free-Lancer · 发表于 2014-9-20 16:01:51

树櫴希德发表于 2014-9-20 15:58
(gc)
(vl-load-com)
;;;;;;;;;;;;;;;;;;;;;;;;;;;

双击看看有没有属性

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

[求助] 为什么CAD2009用ENTMAKE做INSERT,属性跟随ATTRIB

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

点评

点评

点评

点评

点评

点评