Normally a request won't bring much help....
What code do you have so far?
I know. I was just trying to spark interest.
As to the code, I have something from another forum and it is not working just right. It works fine up until it asks to label the line. The block attribute is inserted but the measurement does not enter the block attribute.
Here is the code
(defun C:EVACROUTE (/ *SYSVAR* *DOC* CIRC LABELPT PLIN PLIN2 PT1 PT2 PTLIST RTDIST SPACE)
;;; (C) Richard Lawrence
;;; Provided as is. No Warranty. Use at your own risk.
;;; Permission granted to modify to suit needs.
;;; Only system variables changed are listed under
;;; Save Settings
;;||||||||||||||||||||||||||||||||||
;; Error Handler
;; Function provided by others
;;||||||||||||||||||||||||||||||||||
(defun *ERROR* (MSG)
(if (not
(member
MSG
'("Function cancelled" "console break" "quit / exit abort")
)
)
(alert MSG)
)
(RESTORE_SYS)
(command "_.undo" "end")
(princ)
)
;;||||||||||||||||||||||||||||||||||
;; Set and Save System Variables
;; Function provided by others
;;||||||||||||||||||||||||||||||||||
(defun SAVE_SYS (SYSVAR)
(setq *SYSVAR* '()) ; global var list of saved values
(repeat (length SYSVAR)
(setq *SYSVAR*
(append *SYSVAR*
(list (list (car SYSVAR) (getvar (car SYSVAR))))
)
)
(setq SYSVAR (cdr SYSVAR))
)
)
;;||||||||||||||||||||||||||||||||||
;; Restore System Variables
;; Function provided by others
;;||||||||||||||||||||||||||||||||||
(defun RESTORE_SYS ()
(and (listp *SYSVAR*)
(repeat (length *SYSVAR*)
(setvar (caar *SYSVAR*) (cadar *SYSVAR*))
(setq *SYSVAR* (cdr *SYSVAR*))
)
)
)
;;||||||||||||||||||||||||||||||||||
;; Create Layer
;; Function provided by others
;;||||||||||||||||||||||||||||||||||
(defun MLAYC (LAYNAME COLOR)
(if (= NIL (tblsearch "layer" LAYNAME)) ; check if LAYER exist
(command "-layer" "m" LAYNAME "c" COLOR "" "")
;if not exist, create LAYER
(progn
(command "-layer" "t" LAYNAME "") ; Thaw LAYER
(command "-layer" "on" LAYNAME "") ; Turn on LAYER
(command "-layer" "s" LAYNAME "") ; Set LAYER CURRENT
)
)
)
;;; utility to insert a linetype if not already in drawing
(defun INSLTYPE (LTYPE LTFILE /)
(if (not (tblsearch "ltype" LTYPE))
(command "linetype" "l" LTYPE LTFILE "")
) ;_ end of if
) ;_ end of defun
;;__ Save Settings___
(SAVE_SYS '("CMDECHO" "CLAYER" "OSMODE" "PLINEWID")
)
;;__ Set Settings for Function __
(setvar "CMDECHO" 0)
(setvar "PLINEWID" 4.0)
(command "_.UNDO" "BEgin")
(setq LAYERNAME "EVAC-ROUTE"
LAYERCOLOR "7"
LAYERLTYPE "HIDDEN"
PLINEWID 4.0 ;_ Inches
BLOCKNAME "EVACUATION DISTANCE TAG"
)
(MLAYC LAYERNAME LAYERCOLOR)
(if (not
(= "Continuous"
(cdr (assoc 6 (setq TEMP (tblsearch "Layer" "EVAC-ROUTE"))))
)
)
(command "-layer" "ltype" "Continuous" LAYERNAME "")
)
;;; insert block definition if not already in drawing
(if (not (tblsearch "block" BLOCKNAME))
(progn
(if (findfile BLOCKNAME)
(command "-insert" BLOCKNAME NIL)
(progn
(alert
(strcat "Block: "
BLOCKNAME
" not found in search path. Verify location and retry."
)
)
(quit)
)
)
)
(progn
;;||||||||||||||||||||||||||||||||||
;; Get current space
;; Function provided by others
;;||||||||||||||||||||||||||||||||||
(vl-load-com)
(setq *DOC* (vla-get-activedocument (vlax-get-acad-object)))
(setq SPACE (if (= 1 (vla-get-activespace *DOC*))
(vla-get-modelspace *DOC*) ;we're in modelspace
(if (= (vla-get-mspace *DOC*) :vlax-true)
(vla-get-modelspace *DOC*) ;we're in modelspace
;thru paperspace VPort
(vla-get-paperspace *DOC*) ;we're in paperspace
)
)
)
;;||||||||||||||||||||||||||||||||||
;; End Get Current Space
;;||||||||||||||||||||||||||||||||||
(prompt "\nCreate Evacuation Route")
(setq PT1 (getpoint "\nSpecify Beginning of Route: ")
PTLIST (list (car PT1) (cadr PT1))
PT2 (getpoint PT1 "\nSpecify next point: ")
RTDIST 0.0
)
(while PT2
(setq RTDIST (+ RTDIST (distance PT2 PT1))
PT1 PT2
PTLIST (append PTLIST (list (car PT1) (cadr PT1)))
PT2 (getpoint PT1 "\nSpecify next point: ")
)
)
(rtos RTDIST 4 4)
(setq PLIN (vlax-invoke SPACE 'ADDLIGHTWEIGHTPOLYLINE PTLIST)
PLIN (entlast)
)
(setvar "osmode" 512)
(setq LABELPT (getpoint "\nSpecify label location: "))
(setq CIRC (vlax-invoke SPACE 'ADDCIRCLE LABELPT 12.0)
CIRC (entlast)
)
(command "zoom" "Object" CIRC "")
(command "trim" CIRC "" LABELPT "")
(setq PLIN2 (entget (entlast))
PLIN (entget PLIN)
)
(if (assoc 43 PLIN)
(setq PLIN (subst (cons 43 4.0) (assoc 43 PLIN) PLIN))
(setq PLIN (append PLIN (list (cons 43.0))))
)
(if (assoc 43 PLIN2)
(setq PLIN2 (subst (cons 43 4.0) (assoc 43 PLIN2) PLIN2))
(setq PLIN2 (append PLIN2 (list (cons 43.0))))
)
(entmod PLIN)
(entmod PLIN2)
(entdel CIRC)
(command "-insert"
BLOCKNAME
LABELPT
1
1
0
(rtos RTDIST 4 0)
)
(command "zoom" "Previous")
(INSLTYPE LAYERLTYPE "acad.lin")
(command "-layer" "ltype" LAYERLTYPE LAYERNAME "")
)
) ;_ end of if
(command "_.UNDO" "End")
(RESTORE_SYS)
(princ)
)
Here is what it said when I wanted to label the line.
Command: evacroute
Create Evacuation Route
Specify Beginning of Route:
Specify next point:
Specify next point:
Specify next point:
Specify next point:
Specify label location: Unknown command "26'-10"". Press F1 for help.
How about just trying to insert a circle and just text for the measurement.
Thank you,
Brad
