[编程交流] 在的端点插入块

(defun c:gtas ( / 
                 LM:SelectIf LM:setdynpropvalue cd:BLK_InsertBlock 
                 _ent _start_param _start_hlp_param _end_param _end_hlp_param
             )
 ;;; SUB
 
 (defun LM:SelectIf ( msg pred func keyw / sel ) (setq pred (eval pred))  
   (while
     (progn (setvar 'ERRNO 0) (if keyw (apply 'initget keyw)) (setq sel (func msg))
       (cond
         ( (= 7 (getvar 'ERRNO))
           (princ "\nMissed, Try again.")
         )
         ( (eq 'STR (type sel))
           nil
         )
         ( (vl-consp sel)
           (if (and pred (not (pred sel)))
             (princ "\nInvalid Object Selected.")
           )
         )
       )
     )
   )
   sel
 )
 (defun LM:setdynpropvalue ( blk prp val )
     (setq prp (strcase prp))
     (vl-some
        '(lambda ( x )
             (if (= prp (strcase (vla-get-propertyname x)))
                 (progn
                     (vla-put-value x (vlax-make-variant val (vlax-variant-type (vla-get-value x))))
                     (cond (val) (t))
                 )
             )
         )
         (vlax-invoke blk 'getdynamicblockproperties)
     )
 )
 (defun cd:BLK_InsertBlock (Pb Name Xyz Rot Sup / zdir xang res)
    (setq    
       zdir (trans '(0 0 1) 1 0 T)
       xang (angle '(0 0 0) (trans (getvar "UCSXDIR") 0 zdir))
    )
    (if
     (not
       (vl-catch-all-error-p
         (setq res
           (vl-catch-all-apply
             (quote vla-InsertBlock)
             (list
               (cd:ACX_ASpace)
               (vlax-3d-point (trans Pb 1 0))
               (if (tblsearch "BLOCK" Name)
                 Name
                 (if Sup
                   (findfile (strcat Name ".dwg"))
                   nil
                 )
               )
               (if (not Xyz) 1.0 (car Xyz))
               (if (not Xyz) 1.0 (cadr Xyz))
               (if (not Xyz) 1.0 (caddr Xyz))
               (if (not Rot) 0.0 (+ Rot xang))
             )
           )
         )
       )
     )
     res
   )
 )
 
 
 ;;; END SUB
 
 
 (if 
   (setq _ent 
     (car
       (LM:SelectIf 
         "\nSelect curve to add axis symbol" 
         (lambda ( x ) (wcmatch (cdr (assoc 0 (entget (car x)))) "*LINE") ) 
         entsel nil
       )
     )
   )
   (progn
     (setq 
       _start_param (vlax-curve-getStartParam _ent)
       _start_hlp_param (+ _start_param 0.00001)
       _end_param (vlax-curve-getEndParam _ent)
       _end_hlp_param (- _end_param 0.00001)
     )
     (cd:BLK_InsertBlock
       (trans (vlax-curve-getStartPoint _ent) 0 1)
       "Example 1"
       nil nil nil
     )
     (LM:setdynpropvalue 
       (vlax-ename->vla-object (entlast)) "Angle1" 
       (angle 
         (vlax-curve-getPointAtParam _ent _start_hlp_param)
         (vlax-curve-getPointAtParam _ent _start_param)
       )
     )
     (cd:BLK_InsertBlock
       (trans (vlax-curve-getEndPoint _ent) 0 1)
       "Example 1"
       nil nil nil
     )
     (LM:setdynpropvalue 
       (vlax-ename->vla-object (entlast)) "Angle1" 
       (angle 
         (vlax-curve-getPointAtParam _ent _end_hlp_param)
         (vlax-curve-getPointAtParam _ent _end_param)
       )
     )
   )
 )
 (princ)
)

(defun alg-ang (obj pnt)
 (angle '(0. 0. 0.)
    (vlax-curve-getfirstderiv
      obj
      (vlax-curve-getparamatpoint
        obj
        pnt
      )
    )
 )
)