Message 1 of 1
ADD 02 sub-routines, and add PERPENDICULAR text on the PT and PC stake
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Hello, Good morning!
This is the Lisp of @dlanorh and @dbhunia LABEL5, BY but I set it up the configuration of roads, and to complete it without the help of VCS I believe that it will be impossible, because I manipulated the variables to maximum, but control the radius and the distance of the intersention point until the beginning of the curve is still Unknown,
I ADD 02 subroutines for join this lsp.
(CHANGENT) for ADD Stakes, but they work from 1000 in 1000, but it should be 20 in 20. I would like to stay only with the 3rd option X + XX, XXXM
(CHANGENT ) for Add the lines of PCs and the PTs, but at launch are starting on one side of the line and ending in the other, I tended to delete the circles that generate on the base of it, but every time I take that from the error, which in turn need to add the text PERPENDICULAR to the axis
This is the Lisp of @dlanorh and @dbhunia LABEL5, BY but I set it up the configuration of roads, and to complete it without the help of VCS I believe that it will be impossible, because I manipulated the variables to maximum, but control the radius and the distance of the intersention point until the beginning of the curve is still Unknown,
I ADD 02 subroutines for join this lsp.
(CHANGENT) for ADD Stakes, but they work from 1000 in 1000, but it should be 20 in 20. I would like to stay only with the 3rd option X + XX, XXXM
(CHANGENT ) for Add the lines of PCs and the PTs, but at launch are starting on one side of the line and ending in the other, I tended to delete the circles that generate on the base of it, but every time I take that from the error, which in turn need to add the text PERPENDICULAR to the axis
;===========================================================================================
;===========================================================================================
(vl-load-com)
(DEFUN C:TG () (C:LABEL5))
;===========================================================================================
;===========================================================================================
(defun c:LABEL5 ( / *error* c_doc spc sv_lst sv_vals nw_style nw_font HTX ss o_type pr pt_start pt_end seg_len seg_bulge rad alpha m_pt t_ang t_str nw_obj ll ur att_pt t_width TOTAL_LINE TOTAL_ARC file File_Text);put temp variables
;===========================================================================================
;===========================================================================================
(defun *error* ( msg )
(mapcar 'setvar sv_lst sv_vals)
(if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
(if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nOops an Error : " msg " occurred.")))
(princ)
);end_*error*_defun
;===========================================================================================
;===========================================================================================
(setq c_doc (vla-get-activedocument (vlax-get-acad-object))
spc (if (= 1 (getvar 'cvport))
(vla-get-paperspace c_doc)
(vla-get-modelspace c_doc)
);end_if
sv_lst (list 'osmode 'cmdecho'textstyle 'textsize 'clayer);;system variable names list
sv_vals (mapcar 'getvar sv_lst);;get current values
);end_setq
(cond ( (null (tblsearch "LAYER" "TGCOTA")) (vlax-put (vla-add (vla-get-layers c_doc) "TGCOTA") 'color 7)))
(cond ( (null (tblsearch "STYLE" "DIM"))
(setq nw_style (vla-add (vla-get-textstyles c_doc) "TGCOTA")
nw_font (strcat (getenv "systemroot") "\\Fonts\\ARIAL.ttf")
);end_setq
(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)
);end_mapcar
)
);end_cond
(initget 6)
;OBS0000 - Add variable for start distance stake
;EX: (setq SPEED (getreal (strcat "\nADD/Specify start distance stake: ")))
;OBS0001 - Add variable for text/polyline distance control
;EX: (setq SPEED (getreal (strcat "\nADD/Specify distance text/polyline<" ( 10m?) "> : ")))
;OBS0002 - Add variable to add Project text speed in the fist stake
;EX: (setq SPEED (getreal (strcat "\nADD/Specify speed of project <" ( 40km/h?) "> : ")))
(setq HTX (getreal (strcat "\nADD/Specify text height <" (rtos (getvar "TEXTSIZE")) "> : ")))
(if (not HTX) (setq HTX (getvar 'textsize)))
(mapcar 'setvar sv_lst (list 0 0 "TGCOTA" HTX "TGCOTA")); give them the values you want
(if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
(vla-startundomark c_doc)
(prompt "\nSelect polylines : ")
(while (null (setq ss (ssget '((0 . "LWPOLYLINE")))))
(princ "\nSelection is Empty. Selected Items were not LWPolylines!")
);end_while
(vlax-for obj (vla-get-activeselectionset c_doc)
(setq pr -1.0)
(repeat (fix (vlax-curve-getendparam obj))
(setq pr (1+ pr)
pt_start (vlax-curve-getpointatparam obj pr)
;pt_end (vlax-curve-getpointatparam obj (1+ pr))
seg_len (- (vlax-curve-getdistatparam obj (1+ pr)) (vlax-curve-getdistatpoint obj pt_start))
seg_bulge (vla-getbulge obj pr)
;rad (if (zerop seg_bulge) 0.0 (abs (/ seg_len (* 4.0 (atan seg_bulge)))))
;alpha (if (zerop seg_bulge) (angle (trans pt_start 0 1) (trans pt_end 0 1)) 0.0)
m_pt (vlax-curve-getpointatparam obj (+ 0.5 pr))
alpha (angle '(0 0 0) (vlax-curve-getfirstderiv obj (+ 0.5 pr)))
t_ang alpha
);end_setq
(if (< (/ pi 2) t_ang (* (/ pi 2) 3)) (setq t_ang (+ t_ang pi)))
(if (= seg_bulge 0.0)
;=== ITs ok!
(setq t_str (strcat "DISTANCE: " (rtos seg_len 2 3) "m\\P Az:" (vl-string-subst "%%d" "d" (angtos alpha 1 4))))
;====This need to complement with the numbering of the sequences of curves, and in each one inform AC = Central angle,
;TG the distance from the intersection point to the beginning of the curve, the radius of the curve
;(setq t_str (strcat "CURVE Nº? " "m\\P AC:? " "m\\P TG: ?" "m\\P RAY:?" "m\\P DISTANCE:" (rtos seg_len 2 3)"m."))
;====This line would be for perpendicular TEXT START intersection point and speed of project.
;(setq t_str (strcat "PI = 0 -0,000m START DISTANCE OR DISTANCE SPECIFY" "m\\P SPECIFY SPEED OF PROJETCT"))
;====This line would be for outers perpendicular TEXT in intersection in tangent and curve.
;(setq t_str (strcat "PC+n1 = DISTANCE "))
;====This line would be for CENTER TEXT IN intersection point and speed of project.
;(setq t_str (strcat "PI+N1= NO HAVE DISTANCE"))
;====This line would be for outers perpendicular TEXT in intersection in tangent and curve.
;(setq t_str (strcat "PT+n1 = DISTANCE "))
;====This line would be for perpendicular TEXT END intersection point and speed of project.
; (setq t_str (strcat "PI = END DISTANCE " "m\\P SPECIFY SPEED OF PROJETCT "))
);end_if
(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
; Need a variable to control the spacing of the text and axis line (-10),in OBS001
;at the points where the arcs are the text box invades the design area, and line space factor of 0.80
m_pt (polar m_pt (+ t_ang (/ pi 2)) (* (getvar 'textsize) -10.0))
);end_setq
);end_if
(mapcar '(lambda (pr val) (vlax-put nw_obj pr val))
(list 'AttachmentPoint 'Insertionpoint 'Height 'DrawingDirection 'Rotation 'Width)
(list att_pt m_pt (getvar 'textsize) 5 t_ang 0.0)
);end_mapcar
);end_repeat
);end_for
; (mapcar 'setvar sv_lst sv_vals)
(if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
(princ)
);end_defun
;===========================================================================================
;SUB01
;===========================================================================================
; CHANGENT >>>>>>>>>>>>>>JOIN THIS LSP
; ========
; Description:
; ============
; Draw tangent marks where segments join (but not at start or end of polyline)
; Internal Variables:
; ===================
; l1 = source polyline parsed list
; c1 = count through list l1
; n1 = size of tangent mark
; i1 = item in list l1
; a1 = angle at end of segment
; a2 = angle at start of next segment
; p1 = position of tangent mark on polyline
(defun C:CHANGENT ( / l1 c1 n1 i1 a1 a2 p1)
(chainage_atstart)
; get user to select lightweight polyline (nil if polyline not selected)
(if (/= (setq l1 (chainage_selectpline)) nil)
(progn
; initiate counter and set size of tangent mark (3/4 text size) so chainage mark can extend into tangent mark circles
(setq c1 0 n1 (* (getvar "TEXTSIZE") 0.75))
; go through each segment in polyline
(repeat (length l1)
; get individual segment
(setq i1 (nth c1 l1))
; don't draw start of first segment
(if (> c1 0)
(progn
; calculate angle for line segment
(if (= (car i1) "LINE")
(setq a2 (+ (angle (nth 1 i1) (nth 2 i1)) chainage_halfpi))
; calculate angle at start of arc segment, rotating it 180 degrees if anti-clockwise segment
(progn
(setq a2 (nth 6 i1))
(if (< a2 (nth 7 i1))
(setq a2 (+ a2 chainage_pi))
)
)
)
; take average of angle at end of previous segment and at start of this segment, and get point on polyline
(setq a1 (/ (+ a1 a2) 2.0) p1 (nth 1 i1))
; draw tangent mark (a line with a circle at each end)
(entmake (list (cons 0 "LINE") (cons 100 "AcDbEntity") (cons 100 "AcDbLine")
(append (list 10) (polar p1 a1 n1))
(append (list 11) (polar p1 (+ a1 chainage_pi) (* n1 15)))))
(entmake (list (cons 0 "CIRCLE") (cons 100 "AcDbEntity") (cons 100 "AcDbCircle")
(append (list 10) (polar p1 a1 (* n1 1.35)))
(cons 40 (* n1 0.35))))
(entmake (list (cons 0 "CIRCLE") (cons 100 "AcDbEntity") (cons 100 "AcDbCircle")
(append (list 10) (polar p1 (+ a1 chainage_pi) (* n1 1.35)))
(cons 40 (* n1 0.35))))
)
)
; calculate angle at end of this line segment (including if first segment in list)
(if (= (car i1) "LINE")
(setq a1 (+ (angle (nth 1 i1) (nth 2 i1)) chainage_halfpi))
; calculate angle at end of this arc segment (including if first segment in list) and rotate if anti-clockwise
(progn
(setq a1 (nth 7 i1))
(if (< (nth 6 i1) a1)
(setq a1 (+ a1 chainage_pi))
)
)
)
; increase counter to look at next segment (which will use a1 just calculated)
(setq c1 (1+ c1))
)
(princ "\nCommand finished")
)
)
(chainage_atend)
(princ)
)
; =======================================================================================================
;SUB02
; =======================================================================================================
; CHANGENT
; ========
; Description:
; ============
; Draw tangent marks where segments join (but not at start or end of polyline)
; Internal Variables:
; ===================
; l1 = source polyline parsed list
; c1 = count through list l1
; n1 = size of tangent mark
; i1 = item in list l1
; a1 = angle at end of segment
; a2 = angle at start of next segment
; p1 = position of tangent mark on polyline
(defun C:CHANGENT ( / l1 c1 n1 i1 a1 a2 p1)
(chainage_atstart)
; get user to select lightweight polyline (nil if polyline not selected)
(if (/= (setq l1 (chainage_selectpline)) nil)
(progn
; initiate counter and set size of tangent mark (3/4 text size) so chainage mark can extend into tangent mark circles
(setq c1 0 n1 (* (getvar "TEXTSIZE") 0.75))
; go through each segment in polyline
(repeat (length l1)
; get individual segment
(setq i1 (nth c1 l1))
; don't draw start of first segment
(if (> c1 0)
(progn
; calculate angle for line segment
(if (= (car i1) "LINE")
(setq a2 (+ (angle (nth 1 i1) (nth 2 i1)) chainage_halfpi))
; calculate angle at start of arc segment, rotating it 180 degrees if anti-clockwise segment
(progn
(setq a2 (nth 6 i1))
(if (< a2 (nth 7 i1))
(setq a2 (+ a2 chainage_pi))
)
)
)
; take average of angle at end of previous segment and at start of this segment, and get point on polyline
(setq a1 (/ (+ a1 a2) 2.0) p1 (nth 1 i1))
; draw tangent mark (a line with a circle at each end)
(entmake (list (cons 0 "LINE") (cons 100 "AcDbEntity") (cons 100 "AcDbLine")
(append (list 10) (polar p1 a1 n1))
(append (list 11) (polar p1 (+ a1 chainage_pi) (* n1 15)))))
(entmake (list (cons 0 "CIRCLE") (cons 100 "AcDbEntity") (cons 100 "AcDbCircle")
(append (list 10) (polar p1 a1 (* n1 1.35)))
(cons 40 (* n1 0.35))))
(entmake (list (cons 0 "CIRCLE") (cons 100 "AcDbEntity") (cons 100 "AcDbCircle")
(append (list 10) (polar p1 (+ a1 chainage_pi) (* n1 1.35)))
(cons 40 (* n1 0.35))))
)
)
; calculate angle at end of this line segment (including if first segment in list)
(if (= (car i1) "LINE")
(setq a1 (+ (angle (nth 1 i1) (nth 2 i1)) chainage_halfpi))
; calculate angle at end of this arc segment (including if first segment in list) and rotate if anti-clockwise
(progn
(setq a1 (nth 7 i1))
(if (< (nth 6 i1) a1)
(setq a1 (+ a1 chainage_pi))
)
)
)
; increase counter to look at next segment (which will use a1 just calculated)
(setq c1 (1+ c1))
)
(princ "\nCommand finished")
)
)
(chainage_atend)
(princ)
)
; =======================================================================================================
; =======================================================================================================
