label slope & distance & edit text of point style lisp
Would it be too much to ask if you can post a drawing file instead of just an image?
You can remove all the sensitive info on it before you post, don't need to be the whole file, only a portion of the layout will be enough.
Conditions:
- Set the TEXTSTYLE :
The program uses the CURRENT TEXTSTYLE font and TEXTSIZE for the label, the arrow size will depend on those values as well.
Procedure:
Select two objects at the time, the program will determine which one is the lower value and for the "arrow" direction
- Suggest to use ByLayer on color
- Suggest to use BLOCK object for the arrow
(defun c:HotOffTheGrill ( / Text LWPoly TextData ss data rise run
percentage points ang stringValue linetTo up)
;;; pBe March 2019 ;;;
;;; ;;;
(defun LWPoly (lst cls lay)
(entmakex (append (list (cons 0 "LWPOLYLINE")
(cons 100 "AcDbEntity")
(cons 100 "AcDbPolyline")
(cons 90 (length lst))
(cons 70 cls)(cons 8 lay))
(mapcar (function (lambda (p) (cons 10 p))) lst))))
(setq TextData (mapcar 'getvar '("TEXTSTYLE" "TEXTSIZE")))
(prompt "\nSelect Reference objects")
(while
(and
(setq ss (ssget '((0 . "POINT,INSERT"))))
(= (sslength ss) 2)
)
(setq data
(mapcar
'(lambda (n)
(list
(cdr (assoc 10 (entget (setq e (ssname ss n))))) e ))
'(0 1)
)
)
(setq data
(if (minusp (setq rise
(apply '- (mapcar 'caddr (mapcar 'car data)))))
(reverse data) data))
(setq percentage
(* 100.00
(/
(abs rise)
(setq run
(apply 'distance (setq xy (mapcar '(lambda (p)
(list (car p)(cadr p))) (mapcar 'car data))))))
)
)
(setq linetTo (lwpoly xy 0 "SR_DIM"))
(setq points
(mapcar '(lambda (d)
(polar (Car xy)(angle (Car xy)(cadr xy)) d ))
(list
(- (* run 0.5) (setq l (cadr TextData )))
(* run 0.5)
(+ (* run 0.5) l)
)
)
)
(setq ang (angle '(0.0 0.0 0.0) (vlax-curve-getfirstderiv linetTo
(vlax-curve-getparamatpoint linetTo (car points)))))
(lwpoly (cons (caddr points)
(mapcar '(lambda (s)
(polar (car points) ((eval s) ang (/ pi 2.)) (/ l 3.0))) '(+ -)))
1 "Slope_Arrow")
(setq stringValue (list (strcat (rtos percentage 2 2) "%") (rtos run 2 3)))
(setq textRotation (if
(setq up (and (> ang (/ pi 2)) (<= ang (* pi 1.5)))) (+ ang pi) ang ))
(mapcar '(lambda (pt str)
(entmakex (list (cons 0 "TEXT")
(cons 10 pt) (cons 11 pt)
(cons 50 textRotation)
(cons 40 (Cadr TextData))
(cons 7 (Car TextData))
'(72 . 4)'(73 . 3)(cons 1 str)))
)
(mapcar '(lambda (s)
(polar (append (cadr points)(list 0.0)) ((eval s) ang (/ pi 2.)) (* l 1.25))) '(+ -))
(if up stringValue (reverse stringValue))
)
)
(princ)
)
HTH
this is very nice but i want also to put point elevation text perpendicular to the line for each object and also i want to select multiple objects and make slope for multiple points not only 2 points
@mohamedashraf2014m wrote:
any body can help me in putting z value ( elevation ) perpendicular to line for every point like this
according to this lisp routine ?????
If you ask nicely I'll do it.
@mohamedashraf2014m wrote:
please can you make for me
Sure buddy
As before:
Conditions: - Set the TEXTSTYLE : The program uses the CURRENT TEXTSTYLE font and TEXTSIZE for the label,
the arrow size will depend on those values as well. Procedure: Select TWO (2) objects at a time, the program will determine which one is the lower value and for the "arrow" direction
Selecting all objects at one go is impractical as the program will most likely mess up the pairing.
Not that it's impossible to come up with a program that works all the time ( debatable ) but I personally wouldn't spend time writing one.
See attached file. hOToFFtHEgRILL.LSP (quick mod of the previous routine)
command: hOToFFtHEgRILL
Select Reference objects
Select objects: Specify opposite corner: 2 found
HTH
