Topic: CENTERLINES CENTERLINES

[John Hancock]

I have been using the the lisp program below for a number of years on R14. My problem is that I can't use it above R14. Can you help, please?  

Code: [Select]

;CLINES.LSP creates true centerlines
;PLUS it automatically adjusts - depending on the circle
;or arc size - their courseness and overlap
;
;
(defun C:CL (/ PT R LN PT2 LFAC)
(prompt "\nSelect circle or arc")
(command "select" "si" pause)
(setq PT (ssget "P"))
(setq PT (ssname PT 0))
(setq PT (entget PT))
(setq R (assoc 40 PT))
(setq PT (cdr (assoc 10 PT)))
(setq R (cdr R))
;set primary centerline overlap ratio
(setq R (* 2 R 1.25))
(cond
;auto select fine, standard or course linetypes based
;on size of arc or circle.  Further refines overlap ratio.
((< R 0.9)
(setq LN "center2" LFAC 1.5))
((< R 7.0)
(setq LN "center" LFAC 1.0))
((< R 500.0)
(setq LN "centerx2" LFAC 0.85))
)
(setq R (* R LFAC))
(command "line" PT (polar PT 0 R))
(command)
(setq PT2 (polar Pt 0 ( / R 2)))
(command "move" "1" "" PT2 (polar PT2 pi (/ R 2)))
(command "change" "1" "" "p" "lt" LN "")
(command "array" "1" "" "p" PT 2 90 "")
)
(princ "\nCreates true centerlines  [ CL ]")
(princ)

[Mark]

I believe it's the array command that's giving you grief.

Command: (command "array")
nil

Select objects: 1 found

Select objects:  Enter the type of array [Rectangular/Polar] <R>:

Enter the number of rows (---) <1>:

Enter the number of columns (|||) <1>

One-element array, nothing to do.

[Jeff_M]

In the code you posted these 3 lines all had "1" where "L" was expected....

Code: [Select]


  (command "move" "l" "" PT2 (polar PT2 pi (/ R 2)))
  (command "change" "l" "" "p" "lt" LN "")
  (command "array" "l" "" "p" PT 2 90 "")


[SMadsen]

John, here's a version for r2000 and above that has a little more error checking. For example, it checks for linetype before applying it.

Code: [Select]

(defun getEnt (lst / ent)
  (setvar "ERRNO" 0)
  (while (and (not ent) (/= (getvar "ERRNO") 52))
    (cond ((setq ent (car (entsel)))
           (if (not (member (cdr (assoc 0 (entget ent))) lst))
             (setq ent nil)
           )
          )
    )
  )
  ent
)

(defun loadLtype (ltname ltfile / found doc ltypes ltype fname)
  (setq doc    (vla-get-activedocument (vlax-get-acad-object))
        ltypes (vla-get-linetypes doc)
  )
  (cond
    ((setq fname (findfile ltfile))
     (cond
       ((vl-catch-all-error-p
          (vl-catch-all-apply 'vla-item (list ltypes ltname))
        )
        (vl-catch-all-apply 'vla-load (list ltypes ltname fname))
       )
     )
    )
  )
  (vl-catch-all-apply 'vlax-release-object (list doc))
  (vl-catch-all-apply 'vlax-release-object (list ltypes))
  (if (tblsearch "LTYPE" ltname)
    ltname
  )
)

(defun C:CL (/ ent entl lfac ln ltyp osm pi2 pt r r2)
  (vl-load-com)
  (prompt "\nSelect circle or arc")
  (cond
    ((setq ent (getEnt '("CIRCLE" "ARC")))
     (setq entl (entget ent)
           r    (cdr (assoc 40 entl))
           pt   (cdr (assoc 10 entl))
     )
     (setq r (* 2.0 r 1.25))
     (cond ((< r 0.9) (setq ln "center2" lfac 1.5))
           ((< r 7.0) (setq ln "center" lfac 1.0))
           ((< r 500.0) (setq ln "centerx2" lfac 0.85))
     )
     (if ln
       (cond ((tblsearch "LTYPE" ln))
             ((loadLtype ln "acad.lin"))
             ((princ (strcat "\nCannot find required linetype (" ln ")"))
              (setq ln nil)
             )
       )
     )
     (and ln lfac
          (setq r   (* r lfac)
                r2  (/ r 2.0)
                pi2 (/ pi 2.0)
          )
          (setq osm  (getvar "OSMODE")
                ltyp (getvar "CELTYPE")
          )
          (setvar "OSMODE" 0)
          (setvar "CELTYPE" ln)
          (vl-cmdf "LINE" (polar pt pi r2) (polar pt 0.0 r2) "")
          (vl-cmdf "LINE" (polar pt pi2 r2) (polar pt (- pi2) r2) "")
          (setvar "OSMODE" osm)
          (setvar "CELTYPE" ltyp)
     )
    )
  )
  (princ)
)

[John Hancock]

Thank you one and all ! !