[编程交流] 二维Lisp到三维。。。

(defun c:lemaz(/ sCol bCol nStl nBlk
                     cBlk nAtr ln1 ln2 cAtr)
 
(vl-load-com)
 
(setq aDoc(vla-get-ActiveDocument
      (vlax-get-acad-object))
     sCol(vla-get-TextStyles aDoc)
     bCol(vla-get-Blocks aDoc)
     ); end setq
 (if(vl-catch-all-error-p(vl-catch-all-apply 'vla-Item
 (list sCol "Simplex")))
    (progn
      (setq nStl(vla-Add sCol "Simplex"))
      (vla-put-FontFile nStl "simplex.shx")
     ); end progn
   ); end if
 (if(vl-catch-all-error-p(vl-catch-all-apply 'vla-Item
 (list bCol "Level Marker")))
   (progn
   (setq nBlk(vla-Add bCol
               (vlax-3D-point '(0 0 0))
               "Level Marker"))
   (setq nAtr(vla-AddAttribute nBlk 0.18 acAttributeModePreset
                     "" (vlax-3D-point '(0 0 0)) "LEVEL" "X"))
   (vla-put-Alignment nAtr acAlignmentBottomCenter)
   (vla-put-StyleName nAtr "Simplex")
   (vla-put-TextAlignmentPoint nAtr
     (vlax-3D-point '(0.0 0.1 0.0)))
   (setq ln1(vla-AddLine nBlk(vlax-3D-Point '(-0.09 0.0 0.0))
                    (vlax-3D-Point '(0.09 0.0 0.0)))
         ln2(vla-AddLine nBlk(vlax-3D-Point '(0.0 -0.09 0.0))
                    (vlax-3D-Point '(0.0 0.09 0.0))))
   (mapcar 'vla-put-Layer '(nAtr ln1 ln2) '("0" "0" "0"))
    ); end progn
   ); end if
 (princ "\nPlace level marker or Right Click to Quit> ")
 (while(setq cPt(getpoint))
   (setq cBlk(vla-InsertBlock(vla-get-ModelSpace aDoc)
        (vlax-3D-Point cPt)"Level Marker"
         1.0 1.0 1.0 0.0)
  cAtr(car(vlax-safearray->list
       (vlax-variant-value(vla-GetAttributes cBlk)))))
   (vla-put-TextString cAtr(rtos([color="Blue"]last[/color] cPt)2 2))
   ); end while
 (princ)
 ); end of c:lemaz