RE-ADD FRAGMENT

rolisonfelipe · ‎02-15-2019

Hello, Good morning!
Have as re-add, this fragment, because I discovered that it is possible to shift the text from the project axis up or down, but when add that fragment, and add the variables give error in executing in the CAD.

If possible add a variable to perform this offset, it would be perfect.

ex:(setq OFFSET (getdist (getvar "VIEWCTR") (strcat "\n ENTER VALOR OFFSERT: <" (rtos (getvar "offset)) ">: ")))
Certain of his understanding, and my sincere appreciation

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun c:ROAD ( / js n AcDoc Space ll ur t_width nw_obj att_pt t_ang m_pt nw_objename obj pr nb typ_obj
oldim oldlay a_base a_dir pt_start pt_end pt_cen
rad alpha pt_vtx dist_start dist_end seg_len seg_bulge)

(defun TGTEXTO (ins_txt value_str a / nw_obj)
(setq nw_obj (vla-addMtext Space (vlax-3d-point (trans ins_txt 1 0)) 0.0 value_str))

;;;      (setq nw_obj (vla-addmtext Space (vlax-3d-point m_pt) 0.0 value_str))
;;;      (vla-getboundingbox nw_obj 'll 'ur)
;;;      (setq ll (vlax-safearray->list ll)
;;;            ur (vlax-safearray->list ur)
;;;            t_width (+ (* (distance ll ur) (cos (angle ll ur))) 5.0)
;;;      );end_setq
;;;      (if (>= t_width seg_len)
;;;        (setq att_pt 5
;;;              t_width seg_len
;;;        );end_setq
;;;        (setq att_pt 8
;;; m_pt (polar m_pt (+ t_ang (/ pi 2)) (* (getvar 'TEXTSIZE) 10)) <----This is the value that controls the OFFSET of the text
;;;        );end_setq
;;;      );end_if

      (mapcar '(lambda (pr val) (vlax-put nw_obj pr val))
      (list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'StyleName 'Layer 'Rotation)
      (list 5 (getvar "TEXTSIZE") 5 ins_txt "TGDdim" "TGCOTA" (if (and (< a (* pi 0.5)) (> a (* pi 1.5))) (setq a (+ a pi)) a)) )
    (entmod
      (append
      (vl-remove-if
        (function
          (lambda (x)
            (or (member (car x) '(90 63 421 45))
              (< 419 (car x) 440))))
        (entget (entlast)))
      (list
        '(90 . 1)
        '(63 . 41)
        '(421 . 16770196)
        '(45 . 1.5) ) ) )
    (entupd (entlast)))
(princ "\nSelect polylines/Arc : ")
(setq
    js
    (ssget
      '((-4 . "<OR")
        (-4 . "<AND")
          (0 . "POLYLINE")
          (-4 . "<NOT")
            (-4 . "&") (70 . 126)
          (-4 . "NOT>")
        (-4 . "AND>")
        (0 . "LWPOLYLINE,ARC")
        (-4 . "OR>"))
    )
    n -1
)
(cond
    (js
      (setq
        AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
        Space
          (if (= 1 (getvar "CVPORT"))
            (vla-get-PaperSpace AcDoc)
            (vla-get-ModelSpace AcDoc) ) nb 0 )
      (cond
        ((null (tblsearch "LAYER" "TGCOTA"))
          (vlax-put (vla-add (vla-get-layers AcDoc) "TGCOTA") 'Color 7) ) )
      (cond
        ((null (tblsearch "STYLE" "TGDdim"))
          (setq nw_style (vla-add (vla-get-textstyles AcDoc) "TGDdim")
                nw_font (strcat (getenv "systemroot") "\\Fonts\\Arial.ttf") )
          (mapcar '(lambda (pr val) (vlax-put-property nw_style pr val))
               (list 'FontFile 'Height 'ObliqueAngle 'Width 'TextGenerationFlag)
               (list nw_font 0.0 (/ (* 0.0 pi) 180) 1.0 0.0) ) ) )
      (setq
  oldim   (getvar "dimzin")
  oldlay   (getvar "clayer")
  a_base   (getvar "ANGBASE")
  a_dir   (getvar "ANGDIR")
      )
      (setvar "dimzin" 0) (setvar "clayer" "TGCOTA")
      (setvar "ANGBASE" 0) (setvar "ANGDIR" 0)
      (initget 6)
      (setq h_t (getdist (getvar "VIEWCTR") (strcat "\nTaille du texte <" (rtos (getvar "textsize")) ">: ")))
      (if (null h_t) (setq h_t (getvar "textsize")) (setvar "textsize" h_t))
      (repeat (sslength js)
        (setq
          ename (ssname js (setq n (1+ n)))
          obj (vlax-ename->vla-object ename) pr -1 nb 0 )
        (setq typ_obj (vla-get-ObjectName obj))
        (if (eq typ_obj "AcDbArc")
          (progn
            (setq
              pt_start   (vlax-get obj 'StartPoint)
              pt_end   (vlax-get obj 'EndPoint)
              pt_cen   (vlax-get obj 'Center)
              rad   (vlax-get obj 'Radius)
              alpha   (* (vlax-get obj 'TotalAngle) 0.5)
              seg_len   (vlax-get obj 'ArcLength)
              pt_vtx   (polar pt_cen (+ (vlax-get obj 'StartAngle) alpha) (+ rad (* rad (1- (/ 1 (cos alpha))))))
              nb   (1+ nb))

            (TGTEXTO
              (mapcar '* (mapcar '+ pt_start pt_end) '(0.5 0.5 0.5))
              (strcat
                "{\\fArial Narrow|b0|i0|c0|p34;"
                "CURVE N+" (itoa nb)
                "\\P AC:" (angtos (- pi (* 2 alpha)) 0 4)<---- Because at that point the angle was not degree minutes and seconds
                "%%ddm\\P TG:" (rtos (distance pt_start pt_vtx) 2 3)
                "m\\P RAY:" (rtos rad 2 3)
                "m\\P DISTANCE:" (rtos seg_len 2 3) "m" "}" ) (angle pt_start pt_end) ) )

          (repeat (fix (vlax-curve-getEndParam obj))
            (setq
  dist_start (vlax-curve-GetDistAtParam obj (setq pr (1+ pr)))
  dist_end (vlax-curve-GetDistAtParam obj (1+ pr))
  pt_start   (vlax-curve-GetPointAtParam obj pr)
  pt_end   (vlax-curve-GetPointAtParam obj (1+ pr))
  seg_len (- dist_end dist_start)
  seg_bulge (vla-GetBulge obj pr) )
            (if (not (zerop seg_bulge))

              (progn
                (setq
  rad   (/ seg_len (* 4.0 (atan seg_bulge)))
  alpha   (+ (angle pt_start pt_end) (- (* pi 0.5) (* 2.0 (atan seg_bulge))))
  pt_cen   (polar pt_start alpha rad)
  pt_vtx   (polar pt_start (- alpha (* pi 0.5)) (* rad (/ (sin (* 2.0 (atan seg_bulge))) (cos (* 2.0 (atan seg_bulge))))))
  alpha   (if (< (* 2.0 (atan seg_bulge)) 0) (- pi (* 2.0 (atan seg_bulge))) (* 2.0 (atan seg_bulge)))
  nb    (1+ nb))

                (TGTEXTO
                  (vlax-curve-GetPointAtParam obj (+ 0.5 pr))
                  (strcat
  "{\\fArial Narrow|b0|i0|c0|p34;"
  "CURVE "  (itoa nb)
  "\\P AC:"  (angtos (- pi (* 2 alpha)) 0 4)<---- Because at that point the angle was not degree minutes and seconds
  "%%ddm\\P TG:" (rtos (distance pt_start pt_vtx) 2 3)
  "m\\P RAY:"  (rtos rad 2 3)
  "m\\P DISTANCE:" (rtos seg_len 2 3) "m" "}" )
                  (angle pt_start pt_end) ) )

              (TGTEXTO
                (vlax-curve-GetPointAtParam obj (+ 0.5 pr))
                (strcat
  "{\\fArial Narrow|b0|i0|c0|p34;"
  "DISTANCE "   (rtos seg_len 2 3)
  "m\\P Az:"   (vl-string-subst "%%d" "d" (angtos (+ (angle pt_start pt_end) (- (* pi 0.5) (* 2.0 (atan seg_bulge)))) 1 4)) "}"
                )<---- And at this point of azimuth on Angulo is correct, in degree minutes and second!!!!??
                (angle pt_start pt_end)
              )
            )
          )
        )
      )
      (setvar "dimzin" oldim) (setvar "clayer" oldlay)
      (setvar "ANGBASE" a_base) (setvar "ANGDIR" a_dir)
    )
)
(prin1)
)

Moshe-A · ‎02-15-2019

@rolisonfelipe hi,

ex:(setq OFFSET (getdist (getvar "VIEWCTR") (strcat "\n ENTER VALOR OFFSERT: <" (rtos (getvar "offset)) ">: ")))

you can replace the above code with this call to the following function:

usage:

(setq offset (askoffset (getvar "viewctr") "Enter volar offset" 10))

moshe

(defun askoffset (base msg def / ask)
 (initget (+ 2 4)) ; reject zero + negative values
 (setq ask (getdist base (strcat "\n" msg ": <" (rtos def 2) ">: "))

 (if (not ask)
  (setq ask def)
  (setq def ask)
 ); if
); askoffset

rolisonfelipe · ‎02-16-2019

When the fragment that is with the - ; - You have adjusted this will be possible

Moshe-A · ‎02-16-2019

in AutoLISP terms/format when a line starts with a semicolon ';' character? then all characters coming after are considered comment and not evaluate as code.

when you want a comment to spreads for few lines, start it with ';|' and close it with '|;' for example:

;| this start a multi-line comment

first comment line

second comment line

third comment line

.....

next will close multi-line comment

|;

rolisonfelipe · ‎02-16-2019

I put the; In front of the part that would like it to be reincorporated, and add; Where the error, because if someone is to test what this right will run smoothly, but as to the notation; Is the same usoal, but add the comment with | I got it right now... Thank you...