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

树櫴希德 · 发表于 2014-9-20 16:08:49

(entget (car (entsel ""))'("*"))
((-1 . <图元名: 7ef0f2b8>) (0 . "INSERT") (330 . <图元名: 7ef01cc0>) (5 . "977") (100
. "AcDbEntity") (67 . 0) (410 . "Model") (8 . "tfzj") (6 . "Continuous") (100 .
"AcDbBlockReference") (2 . "GC200") (10 61041.6 11662.9 0.0) (41 . 0.5) (42 .
0.5) (43 . 0.5) (50 . 0.0) (70 . 0) (71 . 0) (44 . 0.0) (45 . 0.0) (210 0.0 0.0
1.0) (-3 ("SOUTH" (1000 . "951495418")))) 只有南方编码

Free-Lancer · 发表于 2014-9-20 16:10:26

树櫴希德发表于 2014-9-20 16:08
(entget (car (entsel ""))'("*"))
((-1 . ) (0 . "INSERT") (330 . ) (5 . "977") (100
. "AcDbEntity" ...

你发个2004完成图上来

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

本帖最后由树櫴希德于 2014-9-20 16:26 编辑

这是2004版本结果图

Free-Lancer · 发表于 2014-9-21 01:51:04

本帖最后由 Free-Lancer 于 2014-9-21 02:35 编辑

树櫴希德发表于 2014-9-20 16:16
这是2004版本结果图

做属性块部分这样

(defun MakeGcd (inspt height scale height2 height3 height4 / blkref
blkdef obj atts)
(setvar "CMDECHO" 0)
(command "layer" "m" "tfzj" "c" "1" "" "L" "CONTINUOUS" "" "")
(regapp "SOUTH")
(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)
(mapcar '(lambda (x)
(vla-addattribute
blkdef
1.
acAttributeModePreset
x
(vlax-3d-point '(0. 0. 0.))
x
""
)
)
'("height" "height2" "heigth3" "height4")
)
)
)
(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) height)
(vla-put-alignment (car atts) acAlignmentRight)
(vla-put-textalignmentpoint
(car atts)
(vlax-3d-point (polar inspt 0. (* 1.2 scale)))
)
(mapcar '(lambda (x y p)
(vla-put-textstring x y)
(vla-put-insertionpoint
x
(vlax-3d-point
(mapcar '+ inspt (mapcar '* p (list scale scale scale)))
)
)
)
(cdr atts)
(list height2 height3 height4)
'((1.2 0.0 0.0) (1.2 -2.0 0.0) (1.2 -4.0 0.0))
)
(entmod (append (entget (vlax-vla-object->ename blkref))
'((-3 ("SOUTH" (1000 . "951495418"))))
)
)
)

(defun MakeGcd (inspt height scale height2 height3 height4 / blkref 
                blkdef obj atts) 
  (setvar "CMDECHO" 0) 
  (command "layer" "m" "tfzj" "c" "1" "" "L" "CONTINUOUS" "" "") 
  (regapp "SOUTH") 
  (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) 
           (mapcar '(lambda (x) 
                      (vla-addattribute 
                        blkdef 
                        1. 
                        acAttributeModePreset 
                        x 
                        (vlax-3d-point '(0. 0. 0.)) 
                        x 
                        "" 
                      ) 
                    ) 
                   '("height" "height2" "heigth3" "height4") 
           ) 
    ) 
  ) 
  (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) height) 
  (vla-put-alignment (car atts) acAlignmentRight) 
  (vla-put-textalignmentpoint 
    (car atts) 
    (vlax-3d-point (polar inspt 0. (* 1.2 scale))) 
  ) 
  (mapcar '(lambda (x y p) 
             (vla-put-textstring x y) 
             (vla-put-insertionpoint 
               x 
               (vlax-3d-point 
                 (mapcar '+ inspt (mapcar '* p (list scale scale scale))) 
               ) 
             ) 
           ) 
          (cdr atts) 
          (list height2 height3 height4) 
          '((1.2 0.0 0.0) (1.2 -2.0 0.0) (1.2 -4.0 0.0)) 
  ) 
  (entmod (append (entget (vlax-vla-object->ename blkref)) 
                  '((-3 ("SOUTH" (1000 . "951495418")))) 
          ) 
  ) 
)

仅对样本有效，用到的函数可以在签名中下载 lib.vlx

(defun makeGCD (/ blkdef obj)
(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)
(mapcar '(lambda (x)
(vla-addattribute
blkdef
1.
acAttributeModePreset
x
(vlax-3d-point '(0. 0. 0.))
x
x
)
)
'("height" "height2" "heigth3" "height4")
)
)
)
)
(defun insertGcd (inspt height scale height2 height3 height4 / blkref
atts)
(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) height)
(vla-put-alignment (car atts) acAlignmentRight)
(vla-put-textalignmentpoint
(car atts)
(vlax-3d-point (polar inspt 0. (* 1.2 scale)))
)
(mapcar '(lambda (x y p)
(vla-put-textstring x y)
(vla-put-insertionpoint
x
(vlax-3d-point
(mapcar '+ inspt (mapcar '* p (list scale scale scale)))
)
)
)
(cdr atts)
(list height2 height3 height4)
'((1.2 0.0 0.0) (1.2 -2.0 0.0) (1.2 -4.0 0.0))
)
(entmod (append (entget (vlax-vla-object->ename blkref))
'((-3 ("SOUTH" (1000 . "951495418"))))
)
)
)
(defun c:pzx (/ str->pt fl lst nl d)
(setq blc (getint "\n请输入比例尺1:"))
(setvar 'userr1 blc) ;_设置比例尺
(setq scale (* 0.001 blc)) ;_缩放比例
(defun XD:Pnt:SetZ (p z)
(list (car p) (cadr p) z)
)
(defun str->pt (str)
(XD:pnt:SetZ
(mapcar 'distof (cdr (String:Parse str ",")))
0.
)
)
(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
(regapp "SOUTH")
(command "layer" "m" "tfzj" "c" "1" "" "L" "CONTINUOUS" "" "")
(if (not (tblobjname "style" "HZ"))
(command "style" "HZ" "rs.shx,hztxt.shx" 0 1 0 "" "")
)
(makeGCD)
(setq lst (XD::List:FromFile fl)
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 tf)
(setq p (Pnts:Center
(list (setq pa (str->pt (cadr x)))
(setq pb (str->pt (caddr x)))
(setq pc (str->pt (cadddr x)))
)
)
bh (vl-remove "" (string:parse (last x) " "))
ll (String:Parse (car x) " ")
)
(insertGcd
p
(cadr ll)
scale
(strcat (car bh) (cadr bh))
(strcat (caddr bh) (last bh))
(strcat "面积:"
(rtos (abs (getplarea (list pa pb pc))) 2 3)
)
)
)
nl
)
)
)
(princ)
)

(defun makeGCD (/ blkdef obj) 
  (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) 
           (mapcar '(lambda (x) 
                      (vla-addattribute 
                        blkdef 
                        1. 
                        acAttributeModePreset 
                        x 
                        (vlax-3d-point '(0. 0. 0.)) 
                        x 
                        x 
                      ) 
                    ) 
                   '("height" "height2" "heigth3" "height4") 
           ) 
    ) 
  ) 
) 
(defun insertGcd (inspt        height scale height2 height3 height4 / blkref 
                  atts) 
  (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) height) 
  (vla-put-alignment (car atts) acAlignmentRight) 
  (vla-put-textalignmentpoint 
    (car atts) 
    (vlax-3d-point (polar inspt 0. (* 1.2 scale))) 
  ) 
  (mapcar '(lambda (x y p) 
             (vla-put-textstring x y) 
             (vla-put-insertionpoint 
               x 
               (vlax-3d-point 
                 (mapcar '+ inspt (mapcar '* p (list scale scale scale))) 
               ) 
             ) 
           ) 
          (cdr atts) 
          (list height2 height3 height4) 
          '((1.2 0.0 0.0) (1.2 -2.0 0.0) (1.2 -4.0 0.0)) 
  ) 
  (entmod (append (entget (vlax-vla-object->ename blkref)) 
                  '((-3 ("SOUTH" (1000 . "951495418")))) 
          ) 
  ) 
) 
(defun c:pzx (/ str->pt fl lst nl d) 
  (setq blc (getint "\n请输入比例尺1:")) 
  (setvar 'userr1 blc) ;_设置比例尺 
  (setq scale (* 0.001 blc)) ;_缩放比例    
  (defun XD:Pnt:SetZ (p z) 
    (list (car p) (cadr p) z) 
  ) 
  (defun str->pt (str) 
    (XD:pnt:SetZ 
      (mapcar 'distof (cdr (String:Parse str ","))) 
      0. 
    ) 
  ) 
  (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 
      (regapp "SOUTH") 
      (command "layer" "m" "tfzj" "c" "1" "" "L" "CONTINUOUS" "" "") 
      (if (not (tblobjname "style" "HZ")) 
        (command "style" "HZ" "rs.shx,hztxt.shx" 0 1 0 "" "") 
      ) 
      (makeGCD) 
      (setq lst        (XD::List:FromFile fl) 
            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 tf) 
           (setq p  (Pnts:Center 
                      (list (setq pa (str->pt (cadr x))) 
                            (setq pb (str->pt (caddr x))) 
                            (setq pc (str->pt (cadddr x))) 
                      ) 
                    ) 
                 bh (vl-remove "" (string:parse (last x) " ")) 
                 ll (String:Parse (car x) " ") 
           ) 
           (insertGcd 
             p 
             (cadr ll) 
             scale 
             (strcat (car bh) (cadr bh)) 
             (strcat (caddr bh) (last bh)) 
             (strcat "面积:" 
                     (rtos (abs (getplarea (list pa pb pc))) 2 3) 
             ) 
           ) 
         ) 
        nl 
      ) 
    ) 
  ) 
  (princ) 
)

Free-Lancer · 发表于 2014-9-21 08:36:18

调整下作块，位置的 Blockdef 时到位

(defun makeGCD (/ blkdef obj atts)
(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)
(setq atts (mapcar '(lambda (x)
(vla-addattribute
blkdef
1.
acAttributeModePreset
x
(vlax-3d-point '(0. 0. 0.))
x
x
)
)
'("height" "height2" "heigth3" "height4")
)
)
(vla-put-alignment (car atts) acAlignmentRight)
(vla-put-textalignmentpoint
(car atts)
(vlax-3d-point '(1.2 0. 0.))
)
(mapcar '(lambda (x y)
(vla-put-insertionpoint x (vlax-3d-point y))
)
(cdr atts)
'((1.2 0.0 0.0) (1.2 -2.0 0.0) (1.2 -4.0 0.0))
)
)
)
)
(defun insertGcd
(inspt height scale height2 height3 height4 / blkref atts)
(setq blkref (vla-insertblock
(fy:acspace)
(vlax-3d-point inspt)
"GC200"
scale
scale
scale
0.
)
atts (vlax-invoke blkref 'Getattributes)
)
(mapcar '(lambda (x y)
(vla-put-textstring x y)
)
atts
(list height height2 height3 height4)
)
(entmod (append (entget (vlax-vla-object->ename blkref))
'((-3 ("SOUTH" (1000 . "951495418"))))
)
)
)
(defun c:pzx (/ str->pt fl lst nl d)
(setq blc (getint "\n请输入比例尺1:"))
(setvar 'userr1 blc)
(setq scale (* 0.001 blc))
(defun str->pt (str)
(XD:pnt:SetZ
(mapcar 'distof (cdr (String:Parse str ",")))
0.
)
)
(if (setq fl (getfiled "Select Log file" "" "log" 8))
(progn
(regapp "SOUTH")
(command "layer" "m" "tfzj" "c" "1" "" "L" "CONTINUOUS" "" "")
(if (not (tblobjname "style" "HZ"))
(command "style" "HZ" "rs.shx,hztxt.shx" 0 1 0 "" "")
)
(makeGCD)
(setq lst (XD::List:FromFile fl)
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 tf)
(setq p (Pnts:Center
(list (setq pa (str->pt (cadr x)))
(setq pb (str->pt (caddr x)))
(setq pc (str->pt (cadddr x)))
)
)
bh (vl-remove "" (string:parse (last x) " "))
ll (String:Parse (car x) " ")
)
(insertGcd
p
(cadr ll)
scale
(strcat (car bh) (cadr bh))
(strcat (caddr bh) (last bh))
(strcat "面积:"
(rtos (abs (Tri:Area pa pb pc)) 2 3)
)
)
)
nl
)
)
)
(princ)
)
;;=====
(defun XD:Pnt:SetZ (p z)
(list (car p) (cadr p) z)
)
(defun Tri:Area (p1 p2 p3)
(abs (* 0.5
(distance p3 p1)
(car (trans (mapcar '- p2 p1) 0 (mapcar '- p3 p1)))
)
)
)

(defun makeGCD (/ blkdef obj atts) 
  (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) 
      (setq atts (mapcar '(lambda (x) 
                            (vla-addattribute 
                              blkdef 
                              1. 
                              acAttributeModePreset 
                              x 
                              (vlax-3d-point '(0. 0. 0.)) 
                              x 
                              x 
                            ) 
                          ) 
                         '("height" "height2" "heigth3" "height4") 
                 ) 
      ) 
      (vla-put-alignment (car atts) acAlignmentRight) 
      (vla-put-textalignmentpoint 
        (car atts) 
        (vlax-3d-point '(1.2 0. 0.)) 
      ) 
      (mapcar '(lambda (x y) 
                 (vla-put-insertionpoint x (vlax-3d-point y)) 
               ) 
              (cdr atts) 
              '((1.2 0.0 0.0) (1.2 -2.0 0.0) (1.2 -4.0 0.0)) 
      ) 
    ) 
  ) 
) 
(defun insertGcd 
       (inspt height scale height2 height3 height4 / blkref atts) 
  (setq        blkref (vla-insertblock 
                 (fy:acspace) 
                 (vlax-3d-point inspt) 
                 "GC200" 
                 scale 
                 scale 
                 scale 
                 0. 
               ) 
        atts   (vlax-invoke blkref 'Getattributes) 
  ) 
  (mapcar '(lambda (x y) 
             (vla-put-textstring x y) 
           ) 
          atts 
          (list height height2 height3 height4) 
  ) 
  (entmod (append (entget (vlax-vla-object->ename blkref)) 
                  '((-3 ("SOUTH" (1000 . "951495418")))) 
          ) 
  ) 
) 
(defun c:pzx (/ str->pt fl lst nl d) 
  (setq blc (getint "\n请输入比例尺1:")) 
  (setvar 'userr1 blc) 
  (setq scale (* 0.001 blc)) 
  (defun str->pt (str) 
    (XD:pnt:SetZ 
      (mapcar 'distof (cdr (String:Parse str ","))) 
      0. 
    ) 
  ) 
 
  (if (setq fl (getfiled "Select Log file" "" "log" 8)) 
    (progn 
      (regapp "SOUTH") 
      (command "layer" "m" "tfzj" "c" "1" "" "L" "CONTINUOUS" "" "") 
      (if (not (tblobjname "style" "HZ")) 
              (command "style" "HZ" "rs.shx,hztxt.shx" 0 1 0 "" "") 
       ) 
      (makeGCD) 
      (setq lst        (XD::List:FromFile fl) 
            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 tf) 
                 (setq p  (Pnts:Center 
                            (list (setq pa (str->pt (cadr x))) 
                                  (setq pb (str->pt (caddr x))) 
                                  (setq pc (str->pt (cadddr x))) 
                            ) 
                          ) 
                       bh (vl-remove "" (string:parse (last x) " ")) 
                       ll (String:Parse (car x) " ") 
                 ) 
                 (insertGcd 
                   p 
                   (cadr ll) 
                   scale 
                   (strcat (car bh) (cadr bh)) 
                   (strcat (caddr bh) (last bh)) 
                   (strcat "面积:" 
                           (rtos (abs (Tri:Area pa pb pc)) 2 3) 
                   ) 
                 ) 
               ) 
              nl 
      ) 
    ) 
  ) 
  (princ) 
) 
;;===== 
(defun XD:Pnt:SetZ (p z) 
  (list (car p) (cadr p) z) 
) 
(defun Tri:Area        (p1 p2 p3) 
  (abs (* 0.5 
          (distance p3 p1) 
          (car (trans (mapcar '- p2 p1) 0 (mapcar '- p3 p1))) 
       ) 
  ) 
)

树櫴希德 · 发表于 2014-9-22 17:42:59

函数是在xd-lisp-lib.VLX里面吗

XDSoft · 发表于 2014-9-22 17:49:03

树櫴希德发表于 2014-9-22 17:42
函数是在xd-lisp-lib.VLX里面吗

xd-lisp-lib.vlx里面的所有函数的源代码都在 LISP论坛下的 “函数库”里面。

树櫴希德 · 发表于 2014-9-22 18:28:15

;;;------------------------------------------------------------------
;;; 返回:
;;; 一个字符串列表。
;;; 示例:
;;; (setq a "harp,guiness,black and tan")
;;; (xd-string_parse a ",")
;;; 返回:
;;; ("harp" "guiness" "black and tan")
;;;------------------------------------------------------------------
(defun STRING:PARSE (str delimiter / post strlst)
(if str
(progn
(setq strlst '())
(while (vl-string-search delimiter str)
(setq post (vl-string-search delimiter str))
(setq strlst (append strlst (list (substr str 1 post))))
(setq str (substr str (+ post 2)))
)
(vl-remove "" (append strlst (list str)))
)
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun Pnts:Center (p1 p2 p3 /)
(mapcar '(lambda (x y z)
(/ (+ x y z) 3.)
)
p1
p2
p3
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun XD::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 makeGCD (/ blkdef obj)
(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)
(mapcar '(lambda (x)
(vla-addattribute
blkdef
1.
acAttributeModePreset
x
(vlax-3d-point '(0. 0. 0.))
x
x
)
)
'("height" "height2" "heigth3" "height4")
)
)
)
)
(defun insertGcd (inspt height scale height2 height3 height4 / blkref
atts)
(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) height)
(vla-put-alignment (car atts) acAlignmentRight)
(vla-put-textalignmentpoint
(car atts)
(vlax-3d-point (polar inspt 0. (* 1.2 scale)))
)
(mapcar '(lambda (x y p)
(vla-put-textstring x y)
(vla-put-insertionpoint
x
(vlax-3d-point
(mapcar '+ inspt (mapcar '* p (list scale scale scale)))
)
)
)
(cdr atts)
(list height2 height3 height4)
'((1.2 0.0 0.0) (1.2 -2.0 0.0) (1.2 -4.0 0.0))
)
(entmod (append (entget (vlax-vla-object->ename blkref))
'((-3 ("SOUTH" (1000 . "951495418"))))
)
)
)
(defun c:pzx (/ str->pt fl lst nl d)
(setq blc (getint "\n请输入比例尺1:"))
(setvar 'userr1 blc) ;_设置比例尺
(setq scale (* 0.001 blc)) ;_缩放比例
(defun XD:Pnt:SetZ (p z)
(list (car p) (cadr p) z)
)
(defun str->pt (str)
(XD:pnt:SetZ
(mapcar 'distof (cdr (String:Parse str ",")))
0.
)
)
(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
(regapp "SOUTH")
(command "layer" "m" "tfzj" "c" "1" "" "L" "CONTINUOUS" "" "")
(if (not (tblobjname "style" "HZ"))
(command "style" "HZ" "rs.shx,hztxt.shx" 0 1 0 "" "")
)
(makeGCD)
(setq lst (XD::List:FromFile fl)
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 tf)
(setq p (Pnts:Center
(list (setq pa (str->pt (cadr x)))
(setq pb (str->pt (caddr x)))
(setq pc (str->pt (cadddr x)))
)
)
bh (vl-remove "" (string:parse (last x) " "))
ll (String:Parse (car x) " ")
)
(insertGcd
p
(cadr ll)
scale
(strcat (car bh) (cadr bh))
(strcat (caddr bh) (last bh))
(strcat "面积:"
(rtos (abs (getplarea (list pa pb pc))) 2 3)
)
)
)
nl
)
)
)
(princ)
)

;;;------------------------------------------------------------------ 
;;;     返回: 
;;;             一个字符串列表。 
;;;             示例: 
;;;             (setq a "harp,guiness,black and tan") 
;;;             (xd-string_parse a ",") 
;;;             返回: 
;;;             ("harp" "guiness" "black and tan") 
;;;------------------------------------------------------------------ 
(defun STRING:PARSE (str delimiter / post strlst) 
  (if str 
    (progn 
      (setq strlst '()) 
      (while (vl-string-search delimiter str) 
        (setq post (vl-string-search delimiter str)) 
        (setq strlst (append strlst (list (substr str 1 post)))) 
        (setq str (substr str (+ post 2))) 
      ) 
      (vl-remove "" (append strlst (list str))) 
    ) 
  ) 
) 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
 
 (defun Pnts:Center (p1 p2 p3 /) 
    (mapcar '(lambda (x y z) 
               (/ (+ x y z) 3.) 
             ) 
            p1 
            p2 
            p3 
    ) 
  ) 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
 
(defun XD::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 makeGCD (/ blkdef obj) 
  (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) 
           (mapcar '(lambda (x) 
                      (vla-addattribute 
                        blkdef 
                        1. 
                        acAttributeModePreset 
                        x 
                        (vlax-3d-point '(0. 0. 0.)) 
                        x 
                        x 
                      ) 
                    ) 
                   '("height" "height2" "heigth3" "height4") 
           ) 
    ) 
  ) 
) 
(defun insertGcd (inspt        height scale height2 height3 height4 / blkref 
                  atts) 
  (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) height) 
  (vla-put-alignment (car atts) acAlignmentRight) 
  (vla-put-textalignmentpoint 
    (car atts) 
    (vlax-3d-point (polar inspt 0. (* 1.2 scale))) 
  ) 
  (mapcar '(lambda (x y p) 
             (vla-put-textstring x y) 
             (vla-put-insertionpoint 
               x 
               (vlax-3d-point 
                 (mapcar '+ inspt (mapcar '* p (list scale scale scale))) 
               ) 
             ) 
           ) 
          (cdr atts) 
          (list height2 height3 height4) 
          '((1.2 0.0 0.0) (1.2 -2.0 0.0) (1.2 -4.0 0.0)) 
  ) 
  (entmod (append (entget (vlax-vla-object->ename blkref)) 
                  '((-3 ("SOUTH" (1000 . "951495418")))) 
          ) 
  ) 
) 
(defun c:pzx (/ str->pt fl lst nl d) 
  (setq blc (getint "\n请输入比例尺1:")) 
  (setvar 'userr1 blc) ;_设置比例尺 
  (setq scale (* 0.001 blc)) ;_缩放比例    
  (defun XD:Pnt:SetZ (p z) 
    (list (car p) (cadr p) z) 
  ) 
  (defun str->pt (str) 
    (XD:pnt:SetZ 
      (mapcar 'distof (cdr (String:Parse str ","))) 
      0. 
    ) 
  ) 
  (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 
      (regapp "SOUTH") 
      (command "layer" "m" "tfzj" "c" "1" "" "L" "CONTINUOUS" "" "") 
      (if (not (tblobjname "style" "HZ")) 
        (command "style" "HZ" "rs.shx,hztxt.shx" 0 1 0 "" "") 
      ) 
      (makeGCD) 
      (setq lst        (XD::List:FromFile fl) 
            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 tf) 
           (setq p  (Pnts:Center 
                      (list (setq pa (str->pt (cadr x))) 
                            (setq pb (str->pt (caddr x))) 
                            (setq pc (str->pt (cadddr x))) 
                      ) 
                    ) 
                 bh (vl-remove "" (string:parse (last x) " ")) 
                 ll (String:Parse (car x) " ") 
           ) 
           (insertGcd 
             p 
             (cadr ll) 
             scale 
             (strcat (car bh) (cadr bh)) 
             (strcat (caddr bh) (last bh)) 
             (strcat "面积:" 
                     (rtos (abs (getplarea (list pa pb pc))) 2 3) 
             ) 
           ) 
         ) 
        nl 
      ) 
    ) 
  ) 
  (princ) 
)

当前图层: tfzj
输入选项
[?/生成(M)/设置(S)/新建(N)/重命名(R)/开(ON)/关(OFF)/颜色(C)/线型(L)/线宽(LW)/材质(MAT)/打印(P)/冻结(F)/
解冻(T)/锁定(LO)/解锁(U)/状态(A)/说明(D)/协调(E)]: m
输入新图层的名称 (成为当前图层) <tfzj>: tfzj 输入选项
[?/生成(M)/设置(S)/新建(N)/重命名(R)/开(ON)/关(OFF)/颜色(C)/线型(L)/线宽(LW)/材质(MAT)/打印(P)/冻结(F)/
解冻(T)/锁定(LO)/解锁(U)/状态(A)/说明(D)/协调(E)]: c
新颜色 [真彩色(T)/配色系统(CO)] : 1
输入图层名列表，这些图层使用颜色 1 (红) <tfzj>: 输入选项
[?/生成(M)/设置(S)/新建(N)/重命名(R)/开(ON)/关(OFF)/颜色(C)/线型(L)/线宽(LW)/材质(MAT)/打印(P)/冻结(F)/
解冻(T)/锁定(LO)/解锁(U)/状态(A)/说明(D)/协调(E)]: L
输入已加载的线型名或 [?] <CONTINUOUS>: CONTINUOUS
输入使用线型“CONTINUOUS”的图层名列表 <tfzj>: 输入选项
[?/生成(M)/设置(S)/新建(N)/重命名(R)/开(ON)/关(OFF)/颜色(C)/线型(L)/线宽(LW)/材质(MAT)/打印(P)/冻结(F)/
解冻(T)/锁定(LO)/解锁(U)/状态(A)/说明(D)/协调(E)]:
命令: ; 错误: 参数太少

XDSoft · 发表于 2014-9-22 18:37:47

树櫴希德发表于 2014-9-22 18:28
;;;------------------------------------------------------------------
;;; 返回:
;;; ...

在发帖时候，如果看到有表情符号，编辑帖子，点开下面的附加选项，把禁用表情给勾上就OK了。

另外，论坛贴LISP代码可以使用 {code=lisp} 你的代码{/code} 用的时候用中括号替换花括号。

csharp · 发表于 2014-9-22 19:04:04

注释掉命令那几句试试

树櫴希德 · 发表于 2014-9-24 09:27:37

在CAD2004中，EATTEDIT增强属性编辑器不可以编辑高程点GC200,有ATTRIB跟随的块，只有ATTEDIT属性编辑器才可以；但是在2009中，ATTEDIT和EATTEDIT都可以编辑有ATTRIB跟随的高程GC200块
?

csharp · 发表于 2014-9-24 10:12:07

树櫴希德发表于 2014-9-24 09:27
在CAD2004中，EATTEDIT增强属性编辑器不可以编辑高程点GC200,有ATTRIB跟随的块，只有ATTEDIT属性编辑器才 ...

只能说越来越高级了，不然autodesk推新版本干什么

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

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

点评

点评

点评

点评

点评