Hi all,
I'm trying to make this work and be more automated and it generates 1 linetype per polyline and it asks only to select a first polyline and it offsets it and add text to the right so we can see what is the linetype name
But the thing is that the text doesnt rotate properly
I'm wondering what i'm missing ?
P.S. I tried with Grok AI tool to give me help so i can get this ready quickly but without a solution
The code :
(defun C:OffsetPolyWithLinetypes (/ *error* ss dist layer linetypes lt-index i pline offset-ent vla-obj doc num-offsets endpt text-pos text-obj)
(vl-load-com)
;; Error handler
(defun *error* (msg)
(if (not (member msg '("Function cancelled" "quit / exit abort")))
(princ (strcat "\nError: " msg))
)
(vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
(setvar "CMDECHO" 1)
(princ)
)
;; Start undo mark
(vla-startundomark (setq doc (vla-get-activedocument (vlax-get-acad-object))))
;; Set system variables
(setvar "CMDECHO" 0)
(setq layer (getvar "CLAYER")) ; Current layer
;; Get all available linetypes in the drawing
(setq linetypes '())
(tblobjname "LTYPE" "*") ; Initialize table scan
(while (setq lt (tblnext "LTYPE" (null lt)))
(setq linetypes (append linetypes (list (cdr (assoc 2 lt)))))
)
;; Load additional linetypes from acad.lin if fewer than 2 linetypes
(if (< (length linetypes) 2)
(progn
(command "._LINETYPE" "_Load" "*" "acad.lin" "")
(setq linetypes '())
(tblobjname "LTYPE" "*") ; Reset table scan
(while (setq lt (tblnext "LTYPE" (null lt)))
(setq linetypes (append linetypes (list (cdr (assoc 2 lt)))))
)
)
)
;; Remove "CONTINUOUS" linetype to avoid assigning it
(setq linetypes (vl-remove "CONTINUOUS" linetypes))
;; Sort linetypes alphabetically
(setq linetypes (vl-sort linetypes '<))
;; Check if linetypes are available
(if (null linetypes)
(progn
(princ "\nNo linetypes available to assign.")
(*error* "No linetypes")
)
)
;; Set number of offsets to the number of available linetypes
(setq num-offsets (length linetypes))
(princ (strcat "\nCreating " (itoa num-offsets) " offset polylines based on available linetypes."))
;; Prompt for polyline selection
(princ "\nSelect polylines to offset: ")
(setq ss (ssget '((0 . "LWPOLYLINE,POLYLINE"))))
(if (not ss)
(progn
(princ "\nNo polylines selected.")
(*error* "No selection")
)
)
;; Prompt for offset distance
(initget 1)
(setq dist (getdist "\nSpecify offset distance (positive for one direction, negative for opposite): "))
(if (not dist)
(progn
(princ "\nInvalid offset distance.")
(*error* "No distance")
)
)
;; Process each polyline
(setq lt-index 0 i 0)
(while (< i (sslength ss))
(setq pline (ssname ss i))
(setq vla-obj (vlax-ename->vla-object pline))
;; Create offsets for each available linetype
(repeat num-offsets
(setq offset-dist (* dist (1+ lt-index))) ; Incremental distance
(if (setq offset-ent (vlax-invoke vla-obj 'Offset offset-dist))
(progn
;; Set the offset polyline to the current layer
(vla-put-layer (car offset-ent) layer)
;; Assign a linetype from the sorted list
(setq ltype (nth lt-index linetypes))
(vla-put-linetype (car offset-ent) ltype)
;; Calculate end point of the offset polyline for text placement
(setq endpt (vlax-curve-getendpoint (car offset-ent)))
;; Offset text to the right (same distance as offset)
(setq text-pos (polar endpt (if (> dist 0) 0.0 pi) (abs dist)))
;; Create text with linetype name using ActiveX
(setq text-obj (vla-addtext
(vla-get-modelspace doc)
ltype
(vlax-3d-point text-pos)
(* (abs dist) 0.3)))
(vla-put-alignment text-obj acAlignmentMiddleLeft)
(vla-put-textalignmentpoint text-obj (vlax-3d-point text-pos))
(vla-put-rotation text-obj (/ pi 2)) ; 90 degrees in radians
(vla-put-layer text-obj layer) ; Set text to current layer
;; Verify rotation
(if (/= (vla-get-rotation text-obj) (/ pi 2))
(progn
(vla-put-rotation text-obj (/ pi 2)) ; Reapply rotation
(princ (strcat "\nReapplied rotation for text: " ltype))
)
)
(setq lt-index (1+ lt-index)) ; Increment linetype index
)
)
)
(setq i (1+ i))
)
;; Clean up
(vla-endundomark doc)
(setvar "CMDECHO" 1)
(princ (strcat "\n" (itoa (* i num-offsets)) " offset polylines created with linetype labels."))
(princ)
)Frank Freitas
CAE/CAD/BIM Coordinator & Support Specialist
