this noobie is almost there

[James Willey]

Hi all,

 

I do not propose to know what i'm doing with regard to LISP coding. I certainly wouldn't know where to start. What I can do though, to a very limited extent, is grasp the understanding of what the code is trying to achieve and manipulate it to my liking based on reading through this forum as a guest. But now i'm stuck so I've signed up and this is my first post.

 

The below routine (of which I've only manipulated the layer name and text height) assesses a Line object and applies a label of DText with a 1:X ratio or % grade of that line, justified at the mid point. That said, I need your help in improving upon the code shown below.

 

Wish List

1. Ensure the LISP does not start as soon as it is loaded through APPLOAD. It must wait for the XF command. This one could be redundant.....it seems temperamental.
2. Ensure the routine does not repeat itself at its conclusion
3. I can insert a "\\" (pause) to allow the user to Enter layer name to make current or <select object>: when the layer command is active and the Set option is selected. What I can't seem to do is make the cursor's aperture appear for the <select object> option. Only the raw cursor appears and the user cannot pick anything but only type the name of a layer.
4. The routine is solely dependant on a Line object and I would like it to also register the two nearest points on a Polyline if required

 

The layer naming and font styles are to suit naming conventions and drafting standards at my workplace.

 

Thanks in advance.

 

; XF  =  CROSS FALL
;
(defun c:XF (/ a a1 b pt1 pt2 slope name cenpt orient namer ans namep)
   (command "ucs" "w")
   (while 1   
   (prompt "Select line to which slope text is to be added")(terpri)
   (setq a1 (entsel))
   (setq a (entget (car a1)))
   (setq b (assoc 0 a))
   (if (= "LINE" (cdr b))
       (progn
       (setq pt1 (cdr (assoc 10 a)))
       (setq pt2 (cdr (assoc 11 a)))
       (setq slope (/ (- (cadr pt2) (cadr pt1)) (- (car pt2) (car pt1))))
       (setq orient (angle pt1 pt2))
       (setq orient (/ (* orient 180.0) pi))
       (if (< slope 0) 
           (progn 
           (setq slope (* slope -1))
           (if (> orient 270) (setq orient (- 450.0 orient )) (setq orient (- 270 orient)))
           )
           (progn
           (if (> orient 180) (setq orient (- 270.0 orient )) (setq orient (- 90.0 orient)))
           )
       )          
       (setq namer (strcat "1:" (rtos (/ 1 slope) 2 1)))    
       (setq slope (* slope 100))
       (setq namep (strcat (rtos slope 2 2) "%"))
       (setq ans (getint "Press 1 for ratio or <%> : "))
       (if ans (setq name namer) (setq name namep)) 
       (setq cenpt (list (/ (+ (car pt1) (car pt2)) 2) (/ (+ (cadr pt1) (cadr pt2)) 2 ) 2))
       (setq cenpt (list (car cenpt) (+ (cadr cenpt) 0)))
       (command "layer" "s" "text25" "")
       (command "style" "ROMANS" "romans.shx" "A" "Y" "" "" "" "" "" "" "")
       (command "text" "s" "ROMANS" "BC" cenpt "2.5" orient name )
       )
   )
  )
)

 

[James Willey]

bump

[devitg]

For better understanding, and, maybe, get further help, please upload such sample.dwg

[BIGAL]

Did you post this request elsewhere ? I posted a different version that does lines and plines.

 

 

XFALLPER.LSP

[James Willey]

1 hour ago, BIGAL said:

Did you post this request elsewhere ? I posted a different version that does lines and plines.

 

No that wasn't me, I'm brand new and I've only posted in this thread so far

Thanks for your routine, I'll check it out

Edited September 10, 2020 by James Willey