Simplify
- Subscribe to RSS Feed
- Mark Topic as New
- Mark Topic as Read
- Float this Topic for Current User
- Bookmark
- Subscribe
- Mute
- Printer Friendly Page
Simplify
Collaborator
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
This is the model of chainage MODEL,
if you know how to configure the PI point of intersection,
I'll be a very grateful!!!
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
I have this lisp, it is very good, but it is not configured properly, because the Chainage is configured from 1000 to 1000m, and the conventional for my regional would be 20 in 20m
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
@rolisonfelipe a écrit :If can take erase the background, and leave the text in color 7, it will be perfect... Att
For background you can remove in fonction (defun add_mt_arc .......) this:
(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))
And for force color you can make this:
Replace
(strcat
"{\\fArial Narrow|b0|i0|c0|p34;"
"PI" (itoa nb) "}" )
by
(strcat
"{\\fArial Narrow|b0|i0|c0|p34;\\C7;"
"PI" (itoa nb) "}" )
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Hello, @CADaSchtroumpf
The Lisp Chainage, I would like to take advantage only the alignments of center points to the beginning and end of the curve and the intersection point from the beginning of the curve to the end of the curve, and at the intersection point Add the text with the name of the Vertice. In case the certice of Pi begins to be counted from 0 at the beginning of the line and from that point continues adding up to the last vertice.
Att.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
You have all many asks similar in forum, I am lost.
You try to adapt many different lisp with a copy-paste section that can interrest you, but the result ...
You want this?
(vl-load-com)
(defun c:XX ( / js n AcDoc Space ename 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 grdraw-id_arc ()
(setvar "CLAYER" "LINE")
(command "._line" "_none" (polar pt_vtx (angle pt_vtx pt_start) 20) "_none" pt_vtx "")
(command "._line" "_none" pt_vtx "_none" (polar pt_vtx (angle pt_vtx pt_end) 20) "")
(command "._line" "_none" pt_start "_none" (polar pt_start (angle pt_start pt_cen) 35) "")
(command "._line" "_none" (polar pt_end (angle pt_start pt_cen) 35) "_none" pt_end "")
(setvar "CLAYER" "TG")
)
(defun add_mt_arc ( / ins_txt h_t)
(initget 9)
(setq ins_txt pt_vtx)
(vla-addMtext Space
(vlax-3d-point (trans ins_txt 1 0))
0.0
(strcat
"{\\fArial Narrow|b0|i0|c0|p34;"
"PI" (itoa nb) "}" )
)
(entmod
(vl-remove-if
(function
(lambda (x)
(or (member (car x) '(90 63 421 45))
(< 419 (car x) 440)
)
)
)
(entget (entlast))
)
)
(entupd (entlast))
)
(princ "\nSélectionner des Arcs/PolyArcs .")
(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" "TG"))
(vlax-put (vla-add (vla-get-layers AcDoc) "TG") 'Color "252")
)
)
(cond
((null (tblsearch "LAYER" "LINE"))
(vlax-put (vla-add (vla-get-layers AcDoc) "LINE") 'Color "252")
)
)
(setq
oldim (getvar "dimzin")
oldlay (getvar "clayer")
a_base (getvar "ANGBASE")
a_dir (getvar "ANGDIR")
)
(setvar "dimzin" 0) (setvar "clayer" "TG")
(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)
)
(grdraw-id_arc)
(add_mt_arc)
)
(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)
)
(grdraw-id_arc)
(add_mt_arc)
)
)
)
)
)
(setvar "dimzin" oldim) (setvar "clayer" oldlay)
(setvar "ANGBASE" a_base) (setvar "ANGDIR" a_dir)
)
)
(prin1)
)
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
HI @CADaSchtroumpf ,
What you're proposing in your schedule meets me, it's my need, but some fragments and details of the initial schedule has been lost.
It is still very complex the "Vlax ", because they require a very specific command, but are extremely efficient, reducing the programming body
But when I comment on other posts I try to take questions and make specific adjustments.
Since I thank you for the Great collaboration
I'm going to assemble all my needs in this LSP
(defun c:1 () (C:ROAD))
(defun c:ROAD ( / js n AcDoc Space ename 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 grdraw-id_arc ()
(setvar "CLAYER" "LINE")
(command "._line" "_none" (polar pt_vtx (angle pt_vtx pt_start) 20) "_none" pt_vtx "")
(command "._line" "_none" pt_vtx "_none" (polar pt_vtx (angle pt_vtx pt_end) 20) "")
(command "._line" "_none" pt_start "_none" (polar pt_start (angle pt_start pt_cen) 35) "")
(command "._line" "_none" (polar pt_end (angle pt_start pt_cen) 35) "_none" pt_end "")
(setvar "CLAYER" "TG")
) ; ****Drawing the notable point in perpendicular this almost OK, obs...the last alignment was not perpendicular
(defun TGTEXTO (ins_txt value_str a / nw_obj)
(initget 9)
(setq ins_txt pt_vtx)
(vla-addMtext Space
(vlax-3d-point (trans ins_txt 1 0))
0.0
(strcat
"{\\fArial Narrow|b0|i0|c0|p34;"
"PI" (itoa nb) "}" )
)
(entmod
(vl-remove-if
(function
(lambda (x)
(or (member (car x) '(90 63 421 45))
(< 419 (car x) 440)
)
)
)
(entget (entlast))
)
)
(entupd (entlast))
) ;****Add text in vertex, it´s OK
(setq nw_obj (vla-addmtext spc (vlax-3d-point m_pt) 0.0 t_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) OFFSEText ))
);end_setq******* I need this fragment back, because I found that this snippet control the offset of the text from the project axis up or down with the use of the variable with the help of the OFFSETEXT that I created.
);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 "TGdim" "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 "\nSélectionner des Arcs/PolyArcs .")
(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" "TG"))
(vlax-put (vla-add (vla-get-layers AcDoc) "TG") 'Color "252") )
);*****Add for control text, its ok
(cond
((null (tblsearch "LAYER" "LINE"))
(vlax-put (vla-add (vla-get-layers AcDoc) "LINE") 'Color "252") )
);*****Add for control line color, its ok
(cond
((null (tblsearch "LAYER" "TGCOTA"))
(vlax-put (vla-add (vla-get-layers AcDoc) "TGCOTA") 'Color 7) ) )
(cond
((null (tblsearch "STYLE" "TGdim"))
(setq nw_style (vla-add (vla-get-textstyles AcDoc) "TGdim")
nw_font (strcat (getenv "systemroot") "\\Fonts\\Arial.ttf") )
(mapcar '(lambda (pr val) (vlax-put-property nw_style pr val))
(list 'FontFile 'Height 'ObliqueAngle 'Width )
(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 "\n Enter TEXT "))))
(setq OFFSEText ((getdist (getvar "VIEWCTR") (strcat "\n Enter OFFSET TEXT: "))))
;;I created this variable to give the text OFFSET, but it will work if the fragment above is re-add
(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))
)
(grdraw-id_arc)
(add_mt_arc)
)
(TGTEXTO
(mapcar '* (mapcar '+ pt_start pt_end) '(0.5 0.5 0.5))
(strcat
"{\\fARIAL|b0|i0|c0;\\C7"
"CURVA " (itoa nb)
"\\P AC:" (vl-string-subst "%%d" "d" (angtos (- pi (* 2 alpha)) 1 4))
"\\P TG:" (rtos (distance pt_start pt_vtx) 2 3)
"m\\P Raio:" (rtos rad 2 3)
"m\\P Distância: " (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 (if (zerop seg_bulge) 0.0 (abs (/ 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))
)
(grdraw-id_arc)
(add_mt_arc)
)
(TGTEXTO
(vlax-curve-GetPointAtParam obj (+ 0.5 pr))
(strcat
"{\\fARIAL|b0|i0|c0;\\C7"
"CURVA " (itoa nb)
"\\P AC:" (vl-string-subst "%%d" "d" (angtos
(- pi (* 2 alpha)) 1 4))
"\\P TG:" (rtos (distance pt_start pt_vtx) 2 3)
"m.\\P Raio:" (rtos rad 2 3)
"m.\\P Distância: " (rtos seg_len 2 3) "m" "}" )
(angle pt_start pt_end) ) )
(TGTEXTO
(vlax-curve-GetPointAtParam obj (+ 0.5 pr))
(strcat
;"{\\fARIAL|b0|i0|c0;\\C7"
"{\\pxqc;"
"Distância: " (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)) "}" )
(angle pt_start pt_end)
)
)
)
)
)
(setvar "dimzin" oldim)
(setvar "clayer" oldlay)
(setvar "ANGBASE" a_base)
(setvar "ANGDIR" a_dir)
)
)
(prin1)
)
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
(defun c:1 () (C:ROAD))
(defun c:ROAD ( / js n AcDoc Space ename 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 grdraw-id_arc ()
(setvar "CLAYER" "LINE")
(command "._line" "_none" (polar pt_vtx (angle pt_vtx pt_start) 20) "_none" pt_vtx "")
(command "._line" "_none" pt_vtx "_none" (polar pt_vtx (angle pt_vtx pt_end) 20) "")
(command "._line" "_none" pt_start "_none" (polar pt_start (angle pt_start pt_cen) 35) "")
(command "._line" "_none" (polar pt_end (angle pt_start pt_cen) 35) "_none" pt_end "")
(setvar "CLAYER" "TG")
) ; ****Drawing the notable point in perpendicular this almost OK, obs...the last alignment was not perpendicular
(defun TGTEXTO (ins_txt value_str a / nw_obj)
(initget 9)
;;;To add the text perpendicular to the points noted this fragment could be written in this way
(setq ins_txt (ANGLE pt_end pt_cen) ;****Add PC text perpendicular
(vla-addMtext Space
(vlax-3d-point (trans ins_txt 1 0))
0.0
(strcat
"{\\fArial Narrow|b0|i0|c0|p34;"
"PC" (itoa nb) "}" )
)
(entmod
(vl-remove-if
(function
(lambda (x)
(or (member (car x) '(90 63 421 45))
(< 419 (car x) 440)
)
)
)
(entget (entlast))
)
)
(entupd (entlast))
) ;****Add PC text perpendicular
(setq ins_txt (ANGLE pt_start pt_cen) ;****Add PT text perpendicular
(vla-addMtext Space
(vlax-3d-point (trans ins_txt 1 0))
0.0
(strcat
"{\\fArial Narrow|b0|i0|c0|p34;"
"PT" (itoa nb) "}" )
)
(entmod
(vl-remove-if
(function
(lambda (x)
(or (member (car x) '(90 63 421 45))
(< 419 (car x) 440)
)
)
)
(entget (entlast))
)
)
(entupd (entlast))
) ;****Add PT text perpendicular
(setq ins_txt pt_vtx) ;****Add text in vertex, it´s OK
(vla-addMtext Space
(vlax-3d-point (trans ins_txt 1 0))
0.0
(strcat
"{\\fArial Narrow|b0|i0|c0|p34;"
"PI" (itoa nb) "}" )
)
(entmod
(vl-remove-if
(function
(lambda (x)
(or (member (car x) '(90 63 421 45))
(< 419 (car x) 440)
)
)
)
(entget (entlast))
)
)
(entupd (entlast))
) ;****Add text in vertex, it´s OK
(setq nw_obj (vla-addmtext spc (vlax-3d-point m_pt) 0.0 t_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) OFFSEText ))
);end_setq******* I need this fragment back, because I found that this snippet control the offset of the text from the project axis up or down with the use of the variable with the help of the OFFSETEXT that I created.
);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 "TGdim" "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 "\nSélectionner des Arcs/PolyArcs .")
(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" "TG"))
(vlax-put (vla-add (vla-get-layers AcDoc) "TG") 'Color "252") )
);*****Add for control text, its ok
(cond
((null (tblsearch "LAYER" "LINE"))
(vlax-put (vla-add (vla-get-layers AcDoc) "LINE") 'Color "252") )
);*****Add for control line color, its ok
(cond
((null (tblsearch "LAYER" "TGCOTA"))
(vlax-put (vla-add (vla-get-layers AcDoc) "TGCOTA") 'Color 7) ) )
(cond
((null (tblsearch "STYLE" "TGdim"))
(setq nw_style (vla-add (vla-get-textstyles AcDoc) "TGdim")
nw_font (strcat (getenv "systemroot") "\\Fonts\\Arial.ttf") )
(mapcar '(lambda (pr val) (vlax-put-property nw_style pr val))
(list 'FontFile 'Height 'ObliqueAngle 'Width )
(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 "\n Enter TEXT "))))
(setq OFFSEText ((getdist (getvar "VIEWCTR") (strcat "\n Enter OFFSET TEXT: "))))
;;I created this variable to give the text OFFSET, but it will work if the fragment above is re-add
(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))
)
(grdraw-id_arc)
(add_mt_arc)
)
(TGTEXTO
(mapcar '* (mapcar '+ pt_start pt_end) '(0.5 0.5 0.5))
(strcat
"{\\fARIAL|b0|i0|c0;\\C7"
"CURVA " (itoa nb)
"\\P AC:" (vl-string-subst "%%d" "d" (angtos (- pi (* 2 alpha)) 1 4))
"\\P TG:" (rtos (distance pt_start pt_vtx) 2 3)
"m\\P Raio:" (rtos rad 2 3)
"m\\P Distância: " (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 (if (zerop seg_bulge) 0.0 (abs (/ 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))
)
(grdraw-id_arc)
(add_mt_arc)
)
(TGTEXTO
(vlax-curve-GetPointAtParam obj (+ 0.5 pr))
(strcat
"{\\fARIAL|b0|i0|c0;\\C7"
"CURVA " (itoa nb)
"\\P AC:" (vl-string-subst "%%d" "d" (angtos
(- pi (* 2 alpha)) 1 4))
"\\P TG:" (rtos (distance pt_start pt_vtx) 2 3)
"m.\\P Raio:" (rtos rad 2 3)
"m.\\P Distância: " (rtos seg_len 2 3) "m" "}" )
(angle pt_start pt_end) ) )
(TGTEXTO
(vlax-curve-GetPointAtParam obj (+ 0.5 pr))
(strcat
;"{\\fARIAL|b0|i0|c0;\\C7"
"{\\pxqc;"
"Distância: " (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)) "}" )
(angle pt_start pt_end)
)
)
)
)
)
(setvar "dimzin" oldim)
(setvar "clayer" oldlay)
(setvar "ANGBASE" a_base)
(setvar "ANGDIR" a_dir)
)
)
(prin1)
)
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Hi,
I have a little time.
You can try this, I think that it is what you want.
(vl-load-com)
(defun c:DIM_ROAD ( / js n AcDoc Space nb oldim oldlay a_base a_dir h_t ename obj pr typ_obj
dist_start dist_end pt_start pt_end pt_cen rad alpha seg_len seg_bulge
pt_vtx total_dist partial_dist val_txt increment_dist lst_pt ang)
(defun draw-line (n n_ang n_dist n_dxf n_lay n_col / )
(entmake
(list
(cons 0 "LINE")
(cons 100 "AcDbEntity")
(assoc 67 n_dxf)
(assoc 410 n_dxf)
(cons 8 n_lay)
(cons 62 n_col)
(cons 100 "AcDbLine")
(cons 10 n)
(cons 11 (polar n n_ang n_dist))
(assoc 210 n_dxf)
)
)
)
(defun add_mt_arc (ins_txt val_txt l_val / )
(vla-addMtext Space
(vlax-3d-point (trans ins_txt 1 0))
0.0
(strcat
"{\\fArial Narrow|b0|i0|c0|p34;\\C7;"
val_txt
"}"
)
)
(mapcar
'(lambda (pr val)
(vlax-put (vlax-ename->vla-object (entlast)) pr val)
)
(list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'StyleName 'Layer 'Rotation)
l_val
)
(entmod
(vl-remove-if
(function
(lambda (x)
(or (member (car x) '(90 63 421 45))
(< 419 (car x) 440)
)
)
)
(entget (entlast))
)
)
(entupd (entlast))
)
(princ "\nSélectionner des Arcs/PolyArcs .")
(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)
)
)
(cond
((null (tblsearch "LAYER" "TG"))
(vlax-put (vla-add (vla-get-layers AcDoc) "TG") 'Color "252")
)
)
(cond
((null (tblsearch "LAYER" "LINE"))
(vlax-put (vla-add (vla-get-layers AcDoc) "LINE") 'Color "252")
)
)
(setq
oldim (getvar "dimzin")
oldlay (getvar "clayer")
a_base (getvar "ANGBASE")
a_dir (getvar "ANGDIR")
)
(setvar "dimzin" 0) (setvar "clayer" "TG")
(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
dist_start (vlax-curve-GetDistAtParam obj (setq pr (1+ pr)))
dist_end (vlax-curve-GetDistAtParam obj (1+ pr))
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))))))
total_dist (vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj))
partial_dist 20.0
nb (1+ nb)
)
(draw-line pt_vtx (angle pt_vtx pt_start) 20 (entget ename) "LINE" 256)
(draw-line pt_vtx (angle pt_vtx pt_end) 20 (entget ename) "LINE" 256)
(draw-line pt_start (angle pt_start pt_cen) 35 (entget ename) "LINE" 256)
(draw-line pt_end (angle pt_end pt_start) 35 (entget ename) "LINE" 256)
(add_mt_arc pt_vtx (strcat "PI" (itoa nb)) 0.0)
)
(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))
seg_len (- dist_end dist_start)
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)
total_dist (vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj))
partial_dist 20.0
)
(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))))))
nb (1+ nb)
)
(draw-line pt_vtx (angle pt_vtx pt_start) 20 (entget ename) "LINE" 256)
(draw-line pt_vtx (angle pt_vtx pt_end) 20 (entget ename) "LINE" 256)
(draw-line pt_start (angle pt_start pt_cen) 35 (entget ename) "LINE" 256)
(add_mt_arc
(polar pt_start (angle pt_start pt_cen) 10)
(strcat "PC" (itoa nb) " = " (itoa (fix (* 0.05 dist_start))) "+" (rtos (* 20.0 (- (* 0.05 dist_start) (fix (* 0.05 dist_start)))) 2 3))
(list 1 (getvar "TEXTSIZE") 5 (polar pt_start (angle pt_start pt_cen) 10) "Standard" "TG" (angle pt_start pt_cen))
)
(draw-line pt_end (angle pt_end pt_cen) 35 (entget ename) "LINE" 256)
(add_mt_arc pt_vtx (strcat "PI" (itoa nb)) (list 8 (getvar "TEXTSIZE") 5 pt_vtx "Standard" "TG" 0.0))
(add_mt_arc
(mapcar '* (mapcar '+ pt_vtx pt_cen) '(0.5 0.5 0.5))
(strcat
"{\\fArial Narrow|b0|i0|c0|p34;"
"CURVA " (itoa nb)
"\\PAC: " (vl-string-subst "%%d" "d" (angtos (- pi (* 2 alpha)) 1 4))
"\\PTg: " (rtos (distance pt_start pt_vtx) 2 3)
"\\PRaio: " (rtos rad 2 3)
"\\PD = " (rtos seg_len 2 3)
"}"
)
(list 5 (getvar "TEXTSIZE") 5 (mapcar '* (mapcar '+ pt_vtx pt_cen) '(0.5 0.5 0.5)) "Standard" "TG" 0.0)
)
)
(progn
(setq
val_txt
(strcat
"Distância: " (rtos seg_len 2 3) "\\P"
"Azimute:" (vl-string-subst "%%d" "d" (angtos (angle pt_start pt_end) 1 4))
)
)
(draw-line pt_start (+ (* 0.5 pi) (angle pt_start pt_end)) 35 (entget ename) "LINE" 256)
(draw-line pt_end (+ (* 0.5 pi) (angle pt_start pt_end)) 35 (entget ename) "LINE" 256)
(add_mt_arc
(polar pt_start (+ (* 0.5 pi) (angle pt_start pt_end)) 10)
(strcat "PT" (itoa nb) " = " (itoa (fix (* 0.05 dist_start))) "+" (rtos (* 20.0 (- (* 0.05 dist_start) (fix (* 0.05 dist_start)))) 2 3))
(list 1 (getvar "TEXTSIZE") 5 (polar pt_start (+ (* 0.5 pi) (angle pt_start pt_end)) 10) "Standard" "TG" (+ (* 0.5 pi) (angle pt_start pt_end)))
)
(add_mt_arc
(polar (vlax-curve-GetPointAtParam ename (+ 0.5 pr)) (- (angle pt_start pt_end) (* pi 0.5)) 10.0)
val_txt
(list 2 (getvar "TEXTSIZE") 5 (polar (vlax-curve-GetPointAtParam ename (+ 0.5 pr)) (- (angle pt_start pt_end) (* pi 0.5)) 10.0) "Standard" "TG" (angle pt_start pt_end))
)
)
)
)
)
(add_mt_arc
(polar pt_end (+ (* 0.5 pi) (angle pt_start pt_end)) 10)
(strcat "PT" (itoa nb) " = " (itoa (fix (* 0.05 dist_end))) "+" (rtos (* 20.0 (- (* 0.05 dist_end) (fix (* 0.05 dist_end)))) 2 3))
(list 1 (getvar "TEXTSIZE") 5 (polar pt_end (+ (* 0.5 pi) (angle pt_start pt_end)) 10) "Standard" "TG" (+ (* 0.5 pi) (angle pt_start pt_end)))
)
(setq increment_dist 0.0 lst_pt nil)
(while (< increment_dist total_dist)
(setq
lst_pt (cons (vlax-curve-getPointAtDist obj increment_dist) lst_pt)
increment_dist (+ increment_dist partial_dist)
)
)
(foreach n lst_pt
(setq ang (angle '(0.0 0.0 0.0) (vlax-curve-getFirstDeriv obj (vlax-curve-getParamAtPoint obj n))))
(draw-line n (+ ang (* pi 0.5)) 2.0 (entget ename) "TG" 3)
(if (zerop (rem (vl-position n (reverse lst_pt)) 5))
(add_mt_arc
(polar n (+ ang (* pi 0.5)) 3)
(itoa (vl-position n (reverse lst_pt)))
(list 8 (getvar "TEXTSIZE") 5 (polar n (+ ang (* pi 0.5)) 3) "Standard" "TG" ang)
)
)
)
)
(setvar "dimzin" oldim) (setvar "clayer" oldlay)
(setvar "ANGBASE" a_base) (setvar "ANGDIR" a_dir)
)
)
(prin1)
)
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Oh! My God!!!!
@CADaSchtroumpf, was exactly what I needed, without words, is perfect, I have no words to say how good it was, I add you, someone could show me where the gold button of solution is accepted ......
I would also like to thank @dbhunia and @dlanorh, for their valuable help, for @DannyNL for guiding the understanding of how to proceed in programming.
To all my deep gratitude. Thank you!!!!!!!
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Sir,
Please can you add to your dim_road LISP diflection angle and external distance for curve (Δ and distance V-C on the picture). I have tried, but with no success.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
@obradsarcevic a écrit :
Sir,
Please can you add to your dim_road LISP diflection angle and external distance for curve (Δ and distance V-C on the picture). I have tried, but with no success.
Code modified
(vl-load-com)
(defun c:DIM_ROAD ( / js n AcDoc Space nb oldim oldlay a_base a_dir h_t ename obj pr typ_obj
dist_start dist_end pt_start pt_end pt_cen rad alpha seg_len seg_bulge
pt_vtx total_dist partial_dist val_txt increment_dist lst_pt ang)
(defun draw-line (n n_ang n_dist n_dxf n_lay n_col / )
(entmake
(list
(cons 0 "LINE")
(cons 100 "AcDbEntity")
(assoc 67 n_dxf)
(assoc 410 n_dxf)
(cons 8 n_lay)
(cons 62 n_col)
(cons 100 "AcDbLine")
(cons 10 n)
(cons 11 (polar n n_ang n_dist))
(assoc 210 n_dxf)
)
)
)
(defun add_mt_arc (ins_txt val_txt l_val / )
(vla-addMtext Space
(vlax-3d-point (trans ins_txt 1 0))
0.0
(strcat
"{\\fArial Narrow|b0|i0|c0|p34;\\C7;"
val_txt
"}"
)
)
(mapcar
'(lambda (pr val)
(vlax-put (vlax-ename->vla-object (entlast)) pr val)
)
(list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'StyleName 'Layer 'Rotation)
l_val
)
(entmod
(vl-remove-if
(function
(lambda (x)
(or (member (car x) '(90 63 421 45))
(< 419 (car x) 440)
)
)
)
(entget (entlast))
)
)
(entupd (entlast))
)
(princ "\nSelect Arcs/PolyArcs .")
(setq
js
(ssget
'((-4 . "<OR")
(-4 . "<AND")
(0 . "POLYLINE")
(-4 . "<NOT")
(-4 . "&") (70 . 126)
(-4 . "NOT>")
(-4 . "AND>")
(0 . "LWPOLYLINE,ARC,LINE")
(-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)
)
)
(cond
((null (tblsearch "LAYER" "TG"))
(vlax-put (vla-add (vla-get-layers AcDoc) "TG") 'Color "252")
)
)
(cond
((null (tblsearch "LAYER" "LINE"))
(vlax-put (vla-add (vla-get-layers AcDoc) "LINE") 'Color "252")
)
)
(setq
oldim (getvar "dimzin")
oldlay (getvar "clayer")
a_base (getvar "ANGBASE")
a_dir (getvar "ANGDIR")
)
(setvar "dimzin" 0) (setvar "clayer" "TG")
(setvar "ANGBASE" 0) (setvar "ANGDIR" 0)
(initget 6)
(setq h_t (getdist (getvar "VIEWCTR") (strcat "\nText size <" (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))
(cond
((eq typ_obj "AcDbArc")
(setq
dist_start (vlax-curve-GetDistAtParam obj (setq pr (1+ pr)))
dist_end (vlax-curve-GetDistAtParam obj (1+ pr))
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))))))
total_dist (vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj))
partial_dist 20.0
nb (1+ nb)
)
(draw-line pt_vtx (angle pt_vtx pt_start) 20 (entget ename) "LINE" 256)
(draw-line pt_vtx (angle pt_vtx pt_end) 20 (entget ename) "LINE" 256)
(draw-line pt_start (angle pt_start pt_cen) 35 (entget ename) "LINE" 256)
(add_mt_arc
(polar pt_start (angle pt_start pt_cen) 10)
(strcat "PC" (itoa nb) " = 0+0.000" )
(list 1 (getvar "TEXTSIZE") 5 (polar pt_start (angle pt_start pt_cen) 10) "Standard" "TG" (angle pt_start pt_cen))
)
(add_mt_arc
(polar pt_end (angle pt_end pt_cen) 10)
(strcat
"PT"
(itoa nb)
" = "
(itoa (fix (* 0.05 (vlax-get obj 'ArcLength))))
"+"
(rtos (* 20.0 (- (* 0.05 (vlax-get obj 'ArcLength)) (fix (* 0.05 (vlax-get obj 'ArcLength))))) 2 3)
)
(list 1 (getvar "TEXTSIZE") 5 (polar pt_end (angle pt_end pt_cen) 10) "Standard" "TG" (angle pt_end pt_cen))
)
(draw-line pt_end (angle pt_end pt_cen) 35 (entget ename) "LINE" 256)
(add_mt_arc pt_vtx (strcat "PI" (itoa nb)) (list 8 (getvar "TEXTSIZE") 5 pt_vtx "Standard" "TG" 0.0))
(add_mt_arc
(mapcar '* (mapcar '+ pt_vtx pt_cen) '(0.5 0.5 0.5))
(strcat
"{\\fArial Narrow|b0|i0|c0|p34;"
"CURVE " (itoa nb)
"\\PAngleTg: " (vl-string-subst "%%d" "d" (angtos (- pi (* 2 alpha)) 1 4))
"\\PLengthTg: " (rtos (distance pt_start pt_vtx) 2 3)
"\\PDeflectionAngle: " (vl-string-subst "%%d" "d" (angtos (* 2 alpha) 1 4))
"\\PApexDistance: " (rtos (- (distance pt_cen pt_vtx) (abs rad)) 2 3)
"\\PRadius: " (rtos rad 2 3)
"\\PCurveDistance = " (rtos seg_len 2 3)
"}"
)
(list 5 (getvar "TEXTSIZE") 5 (mapcar '* (mapcar '+ pt_vtx pt_cen) '(0.5 0.5 0.5)) "Standard" "TG" 0.0)
)
)
((eq typ_obj "AcDbLine")
(setq
pt_start (vlax-curve-GetStartPoint obj)
pt_end (vlax-curve-GetEndPoint obj)
seg_len (distance pt_start pt_end)
total_dist seg_len
partial_dist 20.0
)
(setq
val_txt
(strcat
"Distance: " (rtos seg_len 2 3) "\\P"
"Azimut:" (vl-string-subst "%%d" "d" (angtos (angle pt_start pt_end) 1 4))
)
)
(draw-line pt_start (+ (* 0.5 pi) (angle pt_start pt_end)) 35 (entget ename) "LINE" 256)
(draw-line pt_end (+ (* 0.5 pi) (angle pt_start pt_end)) 35 (entget ename) "LINE" 256)
(add_mt_arc
(polar pt_start (+ (* 0.5 pi) (angle pt_start pt_end)) 10)
(strcat "PC" (itoa nb) " = 0+0.000" )
(list 1 (getvar "TEXTSIZE") 5 (polar pt_start (+ (* 0.5 pi) (angle pt_start pt_end)) 10) "Standard" "TG" (+ (* 0.5 pi) (angle pt_start pt_end)))
)
(add_mt_arc
(polar (polar pt_start (angle pt_start pt_end) (* 0.5 seg_len)) (- (angle pt_start pt_end) (* pi 0.5)) 10.0)
val_txt
(list 2 (getvar "TEXTSIZE") 5 (polar (polar pt_start (angle pt_start pt_end) (* 0.5 seg_len)) (- (angle pt_start pt_end) (* pi 0.5)) 10.0) "Standard" "TG" (angle pt_start pt_end))
)
(add_mt_arc
(polar pt_end (+ (* 0.5 pi) (angle pt_start pt_end)) 10)
(strcat
"PT"
(itoa nb)
" = "
(itoa (fix (* 0.05 seg_len)))
"+"
(rtos (* 20.0 (- (* 0.05 seg_len) (fix (* 0.05 seg_len)))) 2 3)
)
(list 1 (getvar "TEXTSIZE") 5 (polar pt_end (+ (* 0.5 pi) (angle pt_start pt_end)) 10) "Standard" "TG" (+ (* 0.5 pi) (angle pt_start pt_end)))
)
)
(T
(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))
seg_len (- dist_end dist_start)
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)
total_dist (vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj))
partial_dist 20.0
)
(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)
)
(draw-line pt_vtx (angle pt_vtx pt_start) 20 (entget ename) "LINE" 256)
(draw-line pt_vtx (angle pt_vtx pt_end) 20 (entget ename) "LINE" 256)
(draw-line pt_start (angle pt_start pt_cen) 35 (entget ename) "LINE" 256)
(add_mt_arc
(polar pt_start (angle pt_start pt_cen) 10)
(strcat "PC" (itoa nb) " = " (itoa (fix (* 0.05 dist_start))) "+" (rtos (* 20.0 (- (* 0.05 dist_start) (fix (* 0.05 dist_start)))) 2 3))
(list 1 (getvar "TEXTSIZE") 5 (polar pt_start (angle pt_start pt_cen) 10) "Standard" "TG" (angle pt_start pt_cen))
)
(draw-line pt_end (angle pt_end pt_cen) 35 (entget ename) "LINE" 256)
(add_mt_arc pt_vtx (strcat "PI" (itoa nb)) (list 8 (getvar "TEXTSIZE") 5 pt_vtx "Standard" "TG" 0.0))
(add_mt_arc
(mapcar '* (mapcar '+ pt_vtx pt_cen) '(0.5 0.5 0.5))
(strcat
"{\\fArial Narrow|b0|i0|c0|p34;"
"CURVE " (itoa nb)
"\\PAngleTg: " (vl-string-subst "%%d" "d" (angtos (- pi (* 2 alpha)) 1 4))
"\\PLengthTg: " (rtos (distance pt_start pt_vtx) 2 3)
"\\PDeflectionAngle: " (vl-string-subst "%%d" "d" (angtos (* 2 alpha) 1 4))
"\\PApexDistance: " (rtos (- (distance pt_cen pt_vtx) (abs rad)) 2 3)
"\\PRadius: " (rtos rad 2 3)
"\\PCurveDistance = " (rtos seg_len 2 3)
"}"
)
(list 5 (getvar "TEXTSIZE") 5 (mapcar '* (mapcar '+ pt_vtx pt_cen) '(0.5 0.5 0.5)) "Standard" "TG" 0.0)
)
)
(progn
(setq
val_txt
(strcat
"Distance: " (rtos seg_len 2 3) "\\P"
"Azimut:" (vl-string-subst "%%d" "d" (angtos (angle pt_start pt_end) 1 4))
)
)
(draw-line pt_start (+ (* 0.5 pi) (angle pt_start pt_end)) 35 (entget ename) "LINE" 256)
(draw-line pt_end (+ (* 0.5 pi) (angle pt_start pt_end)) 35 (entget ename) "LINE" 256)
(add_mt_arc
(polar pt_start (+ (* 0.5 pi) (angle pt_start pt_end)) 10)
(strcat "PT" (itoa nb) " = " (itoa (fix (* 0.05 dist_start))) "+" (rtos (* 20.0 (- (* 0.05 dist_start) (fix (* 0.05 dist_start)))) 2 3))
(list 1 (getvar "TEXTSIZE") 5 (polar pt_start (+ (* 0.5 pi) (angle pt_start pt_end)) 10) "Standard" "TG" (+ (* 0.5 pi) (angle pt_start pt_end)))
)
(add_mt_arc
(polar (vlax-curve-GetPointAtParam ename (+ 0.5 pr)) (- (angle pt_start pt_end) (* pi 0.5)) 10.0)
val_txt
(list 2 (getvar "TEXTSIZE") 5 (polar (vlax-curve-GetPointAtParam ename (+ 0.5 pr)) (- (angle pt_start pt_end) (* pi 0.5)) 10.0) "Standard" "TG" (angle pt_start pt_end))
)
)
)
)
(add_mt_arc
(polar pt_end (+ (* 0.5 pi) (angle pt_start pt_end)) 10)
(strcat "PT" (itoa nb) " = " (itoa (fix (* 0.05 dist_end))) "+" (rtos (* 20.0 (- (* 0.05 dist_end) (fix (* 0.05 dist_end)))) 2 3))
(list 1 (getvar "TEXTSIZE") 5 (polar pt_end (+ (* 0.5 pi) (angle pt_start pt_end)) 10) "Standard" "TG" (+ (* 0.5 pi) (angle pt_start pt_end)))
)
)
)
(setq increment_dist 0.0 lst_pt nil)
(while (< increment_dist total_dist)
(setq
lst_pt (cons (vlax-curve-getPointAtDist obj increment_dist) lst_pt)
increment_dist (+ increment_dist partial_dist)
)
)
(foreach n lst_pt
(setq ang (angle '(0.0 0.0 0.0) (vlax-curve-getFirstDeriv obj (vlax-curve-getParamAtPoint obj n))))
(draw-line n (+ ang (* pi 0.5)) 2.0 (entget ename) "TG" 3)
(if (zerop (rem (vl-position n (reverse lst_pt)) 5))
(add_mt_arc
(polar n (+ ang (* pi 0.5)) 3)
(itoa (vl-position n (reverse lst_pt)))
(list 8 (getvar "TEXTSIZE") 5 (polar n (+ ang (* pi 0.5)) 3) "Standard" "TG" ang)
)
)
)
)
(setvar "dimzin" oldim) (setvar "clayer" oldlay)
(setvar "ANGBASE" a_base) (setvar "ANGDIR" a_dir)
)
)
(prin1)
)
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Perfect working, thank you very much!
Best regards.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
