Dimension triangle and draw hwight line

topomav · 2022-12-23, 08:39 AM

Hi, Is it possible to dimension a triangle and draw the height line (if the triangle is not orthogonal) with lisp , like the image?
1.jpg

**Bruno.Valsecchi** · 2022-12-23, 03:25 PM

This ?

Code:

(vl-load-com)
(defun c:Height4Triangle ( / ss AcDoc Space txt_size n dxf_ent pt_lst dist_lst pt_first pt_next pt_vertex alpha pt_int)
  (princ "\nSelect polylines")
  (setq ss (ssget '((0 . "LWPOLYLINE") (90 . 3) (-4 . "&") (70 . 1))))
  (cond
    (ss
      (setq
        AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
        Space
        (if (= 1 (getvar "CVPORT"))
          (vla-get-PaperSpace AcDoc)
          (vla-get-ModelSpace AcDoc)
        )
      )
      (vla-startundomark AcDoc)
      (initget 6)
      (if (setq txt_size (getdist (strcat "\nText size? <" (rtos (getvar "TEXTSIZE") 2 2) ">: ")))
        (setvar "TEXTSIZE" txt_size)
      )
      (repeat (setq n (sslength ss))
        (setq
          dxf_ent (entget (ssname ss (setq n (1- n))))
          pt_lst (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) dxf_ent))
          dist_lst (mapcar '(lambda (x y) (distance x y)) pt_lst (append (cdr pt_lst) (list (car pt_lst))))
          pt_first (nth (- (length dist_lst) (length (member (eval (cons 'max dist_lst)) dist_lst))) pt_lst)
          pt_next (nth (- (1+ (length dist_lst)) (length (member (eval (cons 'max dist_lst)) dist_lst))) (append pt_lst (list (car pt_lst))))
          pt_vertex (car (vl-remove pt_first (vl-remove pt_next pt_lst)))
          alpha (angle pt_first pt_next)
          pt_int (inters pt_first pt_next pt_vertex (polar pt_vertex (+ alpha (* 0.5 pi)) (distance pt_first pt_next)) nil)
        )
        (vla-AddLine Space (vlax-3d-point pt_vertex) (vlax-3d-point pt_int))
        (mapcar
          '(lambda (pt alpha txt)
            (setq nw_obj
              (vla-addMtext Space
                (vlax-3d-point pt)
                0.0
                txt
              )
            )
            (mapcar
              '(lambda (pr val)
                (vlax-put nw_obj pr val)
              )
              (list 'AttachmentPoint 'Height 'DrawingDirection 'StyleName 'Layer 'Rotation)
              (list 5 (getvar "TEXTSIZE") 5 (getvar "TEXTSTYLE") (getvar "CLAYER") alpha)
            )
          )
          (list (mapcar '* (mapcar '+ pt_first pt_next) '(0.5 0.5 0.5)) (mapcar '* (mapcar '+ pt_vertex pt_int) '(0.5 0.5 0.5)))
          (list alpha (+ alpha (* 0.5 pi)))
          (list (rtos (distance pt_first pt_next) 2 2) (rtos (distance pt_vertex pt_int) 2 2))
        )
      )
      (vla-endundomark AcDoc)
    )
  )
  (prin1)
)

topomav · 2022-12-23, 03:56 PM

Hi, nice code. Is it possible to add this updates?

Code:

;Layer and text style and text height    
     (if (=(tblsearch "layer" "KT-DIM") nil)
      (command "_layer" "_m" "KT-DIM" "_c" "191" "" "_lw" "0.30" "" "")
     );end if
     (setvar "clayer" "KT-DIM")
 (setq scl (getvar "useri1"))
 (setq ht(* 0.00175 scl))
 (command "-style" "ktdiast" "wgsimpl.shx" "0" "1" "0" "N" "N" "N")

; Triangle line layer
 (COMMAND "_layer" "_m" "HIDDEN 1" "_c" "93" "" "_lt" "LHIDDEN1" "" "_lw" "0.05" "" "")

Thanks

topomav · 2022-12-23, 05:34 PM

I add text style and layer for text

Code:

(vl-load-com)
(defun c:Height4Triangle ( / ss AcDoc Space txt_size n dxf_ent pt_lst dist_lst pt_first pt_next pt_vertex alpha pt_int)
  (princ "\nSelect polylines")
  (setq ss (ssget '((0 . "LWPOLYLINE") (90 . 3) (-4 . "&") (70 . 1))))

     (command "-style" "ktdiast" "wgsimpl.shx" "0" "1" "0" "N" "N" "N")
  (cond
    (ss
      (setq
        AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
        Space
        (if (= 1 (getvar "CVPORT"))
          (vla-get-PaperSpace AcDoc)
          (vla-get-ModelSpace AcDoc)
        )
      )
      (vla-startundomark AcDoc)
      (initget 6)
      (if (setq txt_size (getdist (strcat "\nText size? <" (rtos (getvar "TEXTSIZE") 2 2) ">: ")))
        (setvar "TEXTSIZE" txt_size)
      )
      (repeat (setq n (sslength ss))
        (setq
          dxf_ent (entget (ssname ss (setq n (1- n))))
          pt_lst (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) dxf_ent))
          dist_lst (mapcar '(lambda (x y) (distance x y)) pt_lst (append (cdr pt_lst) (list (car pt_lst))))
          pt_first (nth (- (length dist_lst) (length (member (eval (cons 'max dist_lst)) dist_lst))) pt_lst)
          pt_next (nth (- (1+ (length dist_lst)) (length (member (eval (cons 'max dist_lst)) dist_lst))) (append pt_lst (list (car pt_lst))))
          pt_vertex (car (vl-remove pt_first (vl-remove pt_next pt_lst)))
          alpha (angle pt_first pt_next)
          pt_int (inters pt_first pt_next pt_vertex (polar pt_vertex (+ alpha (* 0.5 pi)) (distance pt_first pt_next)) nil)
        )
        (vla-AddLine Space (vlax-3d-point pt_vertex) (vlax-3d-point pt_int))
        (mapcar
          '(lambda (pt alpha txt)
            (setq nw_obj
              (vla-addMtext Space
                (vlax-3d-point pt)
                0.0
                txt
              )
            )
            (mapcar
              '(lambda (pr val)
                (vlax-put nw_obj pr val)
              )
              (list 'AttachmentPoint 'Height 'DrawingDirection 'StyleName 'Layer 'Rotation)
              (list 5 (getvar "TEXTSIZE") 5 (getvar "TEXTSTYLE") (getvar "CLAYER") alpha)
            )
          )
          (list (mapcar '* (mapcar '+ pt_first pt_next) '(0.5 0.5 0.5)) (mapcar '* (mapcar '+ pt_vertex pt_int) '(0.5 0.5 0.5)))
          (list alpha (+ alpha (* 0.5 pi)))
          (list (rtos (distance pt_first pt_next) 2 2) (rtos (distance pt_vertex pt_int) 2 2))
        )
      )
      (vla-endundomark AcDoc)
    )
  )
  (prin1)
)

1) I can not add the scale for text and line layer.
2) I test the code and i see that in the same side of the drawing I have two overlapping dimensions (Is one dimension from each triangle). Is it possible to insert one dimension and not two?

Code:

;text height by drawing scale  
I have a lisp for scale all text in drawing

 (setq scl (getvar "useri1"))
 (setq ht(* 0.00175 scl))
 (command "-style" "ktdiast" "wgsimpl.shx" "0" "1" "0" "N" "N" "N")

; Triangle line layer
 (COMMAND "_layer" "_m" "HIDDEN 1" "_c" "93" "" "_lt" "LHIDDEN1" "" "_lw" "0.05" "" "")

Thanks

**Bruno.Valsecchi** · 2022-12-23, 07:08 PM

Originally Posted by Razor

Hi, nice code. Is it possible to add this updates?

Code:

;Layer and text style and text height    
     (if (=(tblsearch "layer" "KT-DIM") nil)
      (command "_layer" "_m" "KT-DIM" "_c" "191" "" "_lw" "0.30" "" "")
     );end if
     (setvar "clayer" "KT-DIM")
 (setq scl (getvar "useri1"))
 (setq ht(* 0.00175 scl))
 (command "-style" "ktdiast" "wgsimpl.shx" "0" "1" "0" "N" "N" "N")

; Triangle line layer
 (COMMAND "_layer" "_m" "HIDDEN 1" "_c" "93" "" "_lt" "LHIDDEN1" "" "_lw" "0.05" "" "")

Thanks

You deviate from autocad standards
I can't test because I don't have:
- wgsimpl.shx in my fonts
- LHIDDEN1 in my linetype definitions
- useri1 for me is not a good choice
Why choosing an integer, a real would have been more appropriate! USERR1 for example.

So without having been able to test, the code (you will have to adjust yourself if it does not work):

Code:

(vl-load-com)
(defun c:Height4Triangle ( / ss AcDoc Space lay nw_style txt_size n dxf_ent pt_lst dist_lst pt_first pt_next pt_vertex alpha pt_int)
	(princ "\nSelect polylines")
	(setq ss (ssget '((0 . "LWPOLYLINE") (90 . 3) (-4 . "&") (70 . 1))))
	(cond
		(ss
			(setq
				AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
				Space
				(if (= 1 (getvar "CVPORT"))
					(vla-get-PaperSpace AcDoc)
					(vla-get-ModelSpace AcDoc)
				)
			)
			(vla-startundomark AcDoc)
			(cond
				((null (tblsearch "LAYER" "KT-DIM"))
					(setq lay (vla-add (vla-get-layers AcDoc) "KT-DIM"))
					(vlax-put lay 'color 191)
					(vlax-put lay 'Lineweight 30)
				)
			)
			(cond
				((null (tblsearch "STYLE" "KTDIAST"))
					(setq nw_style (vla-add (vla-get-textstyles AcDoc) "KTDIAST"))
					(mapcar
						'(lambda (pr val)
							(vlax-put nw_style pr val)
						)
						(list 'FontFile 'Height 'ObliqueAngle 'Width 'TextGenerationFlag)
						(list "wgsimpl.shx" 0.0 0.0 1.0 0.0)
					)
				)
			)
			(if
				(and
					(not
						(vlax-for item (vla-get-linetypes AcDoc)
							(if (= (strcase (vla-get-name item)) (strcase "LHIDDEN1")) T)
						)
					)
					(vl-catch-all-error-p
						(vl-catch-all-apply
							'vla-load
							(list (vla-get-Linetypes AcDoc) "LHIDDEN1" "LHIDDEN1.lin")
						)
					)
				)
				nil
				T
			)
			(cond
				((null (tblsearch "LAYER" "HIDDEN 1"))
					(vlax-put (vla-add (vla-get-layers AcDoc) "HIDDEN 1") 'color 93)
				)
			)
			(setq txt_size (* 0.00175 (getvar "USERI1")))
			(repeat (setq n (sslength ss))
				(setq
					dxf_ent (entget (ssname ss (setq n (1- n))))
					pt_lst (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) dxf_ent))
					dist_lst (mapcar '(lambda (x y) (distance x y)) pt_lst (append (cdr pt_lst) (list (car pt_lst))))
					pt_first (nth (- (length dist_lst) (length (member (eval (cons 'max dist_lst)) dist_lst))) pt_lst)
					pt_next (nth (- (1+ (length dist_lst)) (length (member (eval (cons 'max dist_lst)) dist_lst))) (append pt_lst (list (car pt_lst))))
					pt_vertex (car (vl-remove pt_first (vl-remove pt_next pt_lst)))
					alpha (angle pt_first pt_next)
					pt_int (inters pt_first pt_next pt_vertex (polar pt_vertex (+ alpha (* 0.5 pi)) (distance pt_first pt_next)) nil)
				)
				(setq nw_obj (vla-AddLine Space (vlax-3d-point pt_vertex) (vlax-3d-point pt_int)))
				(vlax-put nw_obj 'Layer "HIDDEN 1")
				(mapcar
					'(lambda (pt alpha txt)
						(setq nw_obj
							(vla-addMtext Space
								(vlax-3d-point pt)
								0.0
								txt
							)
						)
						(mapcar
							'(lambda (pr val)
								(vlax-put nw_obj pr val)
							)
							(list 'AttachmentPoint 'DrawingDirection 'Height 'StyleName 'Layer 'Rotation)
							(list 5 5 txt_size "KTDIAST" "KT-DIM" alpha)
						)
					)
					(list (mapcar '* (mapcar '+ pt_first pt_next) '(0.5 0.5 0.5)) (mapcar '* (mapcar '+ pt_vertex pt_int) '(0.5 0.5 0.5)))
					(list alpha (+ alpha (* 0.5 pi)))
					(list (rtos (distance pt_first pt_next) 2 2) (rtos (distance pt_vertex pt_int) 2 2))
				)
			)
			(vla-endundomark AcDoc)
		)
	)
	(prin1)
)

topomav · 2022-12-23, 08:41 PM

Thank you Bruno.Valsecchi. The code works. Ihave some problem with the linetype and the possition of the text ,but i will try to fix it.

Thanks

Thread: Dimension triangle and draw hwight line

Thread Tools

Display

Dimension triangle and draw hwight line

Re: Dimension triangle and draw hwight line

Re: Dimension triangle and draw hwight line

Re: Dimension triangle and draw hwight line

Re: Dimension triangle and draw hwight line

Re: Dimension triangle and draw hwight line

Similar Threads

Need help making a triangle lisp and have no idea.

Is it possible to draw a section that will only appear in the view you draw it

Pentagon and Triangle Windows

Pentagon and Triangle Windows

The impossible triangle made possible

Posting Permissions