Jump to content

CREATE PERPENDICULAR DIMENSION BETWEEN TWO PARALLEL POLYLINES


Recommended Posts

Posted

Hello CadTutor fam, 

 

I am a complete newb at creating Lisps. I am trying to create a lisp that automatically places a dimension between two parallel lines (this is a repetitive task in my field). I've attached the lisp I've got so far, but it only places a line perpendicular to the selected lines. Can someone please help out/point me in the right direction?
image.png.f8e502d652fd25134edf20c5cfec3f5a.png

tpdim.lsp

Posted
21 hours ago, SCHNIPPLES said:

Hello CadTutor fam, 

 

I am a complete newb at creating Lisps. I am trying to create a lisp that automatically places a dimension between two parallel lines (this is a repetitive task in my field). I've attached the lisp I've got so far, but it only places a line perpendicular to the selected lines. Can someone please help out/point me in the right direction?
image.png.f8e502d652fd25134edf20c5cfec3f5a.png

tpdim.lsp 3.37 kB · 1 download

@SCHNIPPLES please upload your-sample.dwg

 

Posted

This has been asked before for that task of dimensioning services in roads. I know did something pick base line then pick other lines and all done. Will try to find may have been a few years ago.

Posted
6 hours ago, SCHNIPPLES said:

@SCHNIPPLES please give it a try 

 

 

;;----------------------------------------------------------------------;;
;; Design and modify  by Gabo CALOS DE VIT from CORDOBA ARGENTINA
;;;    Copyleft 1995-2026 by Gabriel Calos De Vit ; DEVITG@GMAIL.COM    
;Hecho y modificado por  Gabo CALOS DE VIT de CORDOBA ARGENTINA
;;;    Copyleft 1995-2026 por Gabriel Calos De Vit 
;; DEVITG@GMAIL.COM 
;;; inicio-defun-20-ene-2026
;;  as per
;;https://www.cadtutor.net/forum/topic/98950-create-perpendicular-dimension-between-two-parallel-polylines/
;;*-------------------------------------------------------------------------------------------


(defun c:T5
	    (/		 ACAD-OBJ    acExtendNone	     ADOC	 AT&T-STYLE  BASE-OBJ
	     BASEENT	 CE	     CP1	 DERIV	     DIM-STYLES	 DIM-TXT-PT  DIMOBJ
	     INTS-VAR@BASE	     INTS-VAR@TGT	     INTS@BASE	 INTS@TGT    MODEL
	     NRM	 OS	     P		 P1	     P2		 PARAM	     S
	     SEARCHRAD	 SMPL-DIM    SMPL-DIM-LAY	     SMPL-DIM-STYLE	     SMPL-OBJ
	     TAN	 TGT-OBJ     TGTENT	 TMP-OBJ     TMPE	 X
	    ) ;_ end of /
  (VL-LOAD-COM)
  (SETQ ACAD-OBJ (VLAX-GET-ACAD-OBJECT)) ;_ el programa ACAD 
  (SETQ ADOC (VLA-GET-ACTIVEDOCUMENT ACAD-OBJ)) ;_ el DWG que esta abierto-
  (SETQ MODEL (VLA-GET-MODELSPACE ADOC))
  (setq dim-styles (VLA-GET-DIMSTYLES adoc))

  (setq searchRad 2000.0)		; increase if your gaps are big (drawing units)

  (defun v+ (a b) (mapcar '+ a b))
  (defun v- (a b) (mapcar '- a b))
  (defun v* (v s) (mapcar '(lambda (x) (* x s)) v))
  (defun dot (a b)
    (+ (* (car a) (car b))
       (* (cadr a) (cadr b))
       (* (caddr a) (caddr b))
    ) ;_ end of +
  ) ;_ end of defun
  (defun len (v) (sqrt (dot v v)))
  (defun unit (v / L)
    (setq L (len v))
    (if	(> L 1e-12)
      (v* v (/ 1.0 L))
      v
    ) ;_ end of if
  ) ;_ end of defun
  (defun dist (a b) (len (v- a b)))

  (setq os (getvar "OSMODE"))
  (setq ce (getvar "CMDECHO"))
  (setvar "OSMODE" 0)
  (setvar "CMDECHO" 0)
  (alert "\n you have to select a dim you had done ")
  (princ "\n Select a sample dim")
  (setq smpl-dim (ssname (ssget "_:S+." '((0 . "dimension"))) 0))
  (setq baseEnt (car (entsel "\nSelect BASE object (ROW): ")))
  (redraw baseEnt 3)
  (setq base-obj (vlax-ename->vla-object baseEnt))
  (setq tgtEnt (car (entsel "\nSelect TARGET object (BOC/Fiber/etc.): ")))
  (redraw tgtEnt 3)
  (setq tgt-obj (vlax-ename->vla-object tgtEnt))
  (setq	p (getpoint
	    "\nPick dimension location (also picks the side): "
	  ) ;_ end of getpoint
  ) ;_ end of setq



  (if (and baseEnt tgtEnt p)
    (progn
      ;; Closest point on base
      (setq cp1 (vlax-curve-getClosestPointTo baseEnt p))

      ;; Tangent derivative at cp1
      (setq param (vlax-curve-getParamAtPoint baseEnt cp1))
      (setq deriv (vlax-curve-getFirstDeriv baseEnt param))
      (setq tan (unit deriv))

      ;; Normal (perpendicular) in XY
      (setq nrm (unit (list (- (cadr tan)) (car tan) 0.0)))

      ;; Build long perpendicular segment through cp1
      (setq p1 (v- cp1 (v* nrm searchRad)))
					;(setq point@p1 (VLA-ADDPOINT model (VLAX-3D-POINT p1)))
      (setq p2 (v+ cp1 (v* nrm searchRad)))
					;(setq point@p2 (VLA-ADDPOINT model (VLAX-3D-POINT p2)))
      ;; Create temp LINE entity (so we can intersect reliably)
      (setq tmpE
	     (entmakex
	       (list (cons 0 "LINE")
		     (cons 10 p1)
		     (cons 11 p2)
	       ) ;_ end of list
	     ) ;_ end of entmakex
      ) ;_ end of setq

      (setq tmp-obj (vlax-ename->vla-object (entlast)))

      ;; Get intersections between target and temp line
					; You had an error here. it is not 
      ;; (setq ints (vlax-curve-intersectwith tgtEnt tmpE acextendnone))
      ;;it is so    
      (setq ints-var@tgt (vla-intersectwith tgt-obj tmp-obj acextendnone))
      (setq ints@tgt (VLAX-SAFEARRAY->LIST (VLAX-VARIANT-VALUE ints-var@tgt)))
					;(setq point@tgt (VLA-ADDPOINT model ints-var))


      ;; Get intersections between base and templine

      (setq ints-var@base (vla-intersectwith base-obj tmp-obj acextendnone))
      (setq ints@base (VLAX-SAFEARRAY->LIST (VLAX-VARIANT-VALUE ints-var@base)))
					;(setq point@base (VLA-ADDPOINT model ints-var@base))

      (vla-delete tmp-obj)

      ;;(setq smpl-dim (ssname (ssget "_:S+." '((0 . "dimension"))) 0))
      (setq smpl-dim-style (cdr (assoc 3 (entget smpl-dim))))

      (setq smpl-obj (vlax-ename->vla-object smpl-dim))
      (setq smpl-dim-lay (vla-get-layer smpl-obj))

      (setvar 'clayer smpl-dim-lay)

      (setq at&t-style (vla-item dim-styles (VLA-GET-STYLENAME smpl-obj))) ;"AT&T" 

      (vla-put-ActiveDimStyle adoc at&t-style)

      (setq dim-txt-pt (MAPCAR '* '(0.5 0.5 0.5) (MAPCAR '+ ints@base ints@tgt)))
      (setq dimObj (vla-AddDimAligned
		     model
		     ints-var@base
		     ints-var@tgt
		     (VLAX-3D-POINT dim-txt-pt)
		   ) ;_ end of vla-AddDimAligned
      ) ;_ end of setq
    ) ;_ end of progn
  ) ;_ end of if

   (VL-CMDF "regen")
  (setvar "CMDECHO" ce)
  (setvar "OSMODE" os)
  (princ)
) ;_ end of defun
;|«Visual LISP© Format Options»
(100 2 40 2 T "end of " 60 9 0 0 0 T T nil T)
;*** DO NOT add text below the comment! ***|;

 

dim to lines SCHNIPPLES cadtutor.lsp

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...