You'd know how to tell me, why DEFUN PIncert command doesn't load ....And draws the notable lines...
(vl-load-com)
(DEFUN C:TG () (C:ROAD))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:ROAD ( / *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 )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(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
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun PIncert ( / )
(command "._line" pt_start pt_vtx "")
(command "._line" pt_vtx pt_end "")
(command "._line" pt_start pt_cen "")
(command "._line" pt_cen pt_end "")
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(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_if1
sv_lst (list 'osmode 'cmdecho'textstyle 'TEXTSIZE 'clayer);;system variable names list
sv_vals (mapcar 'getvar sv_lst);;get current values
);end_setq1
(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_setq2
(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_mapcar1
)
);end_cond1
;(mapcar 'setvar sv_lst (list 0 0 1 90.0))
(initget 6)
(setq htx (getreal (strcat "\nSpecify 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
;=================
(setq
SS
(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" "Info ARTDB des Arcs"))
(vlax-put (vla-add (vla-get-layers AcDoc) "Info ARTDB des Arcs") 'Color "5")
)
)
(setq
oldim (getvar "dimzin")
oldlay (getvar "clayer")
a_base (getvar "ANGBASE")
a_dir (getvar "ANGDIR")
)
(setvar "dimzin" 0) (setvar "clayer" "Info ARTDB des Arcs")
(setvar "ANGBASE" 0) (setvar "ANGDIR" 0)
(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)
)
(PIncert)
)
(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
;===============================
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
nb (1+ nb)
)
(PIncert)
);end_setq
(if (< (/ pi 2) t_ang (* (/ pi 2) 3)) (setq t_ang (+ t_ang pi)))
(if (= seg_bulge 0.0)
(setq t_str (strcat "Az:" (vl-string-subst "%%d" "d" (angtos alpha 1 4)) "\\P DISTANCE:" (rtos seg_len 2 3) "m" ))
(setq t_str (strcat "CURVE01" "m\\P AC:" (angtos (- pi (* 2 alpha)) 0 4) "%%d" "d" "m\\P TG:""m\\P RAY:" (rtos rad 2 3) "m\\P DISTANCE:" (rtos seg_len 2 3)"m."))
);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
m_pt (polar m_pt (+ t_ang (/ pi 2)) (* (getvar 'TEXTSIZE) 8))
);end_setq
);end_if
(mapcar '(lambda (pr val) (vlax-put nw_obj pr val))
;(list 'AttachmentPoint 'Insertionpoint 'Height 'DrawingDirection 'StyleName 'Layer 'Rotation 'Width)
;(list att_pt m_pt (getvar 'TEXTSIZE) 5 "TGCOTA" "TGCOTA" t_ang t_width)
(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
