Jump to content

continue Dimension with aligned option Lisp required

hibba

By hibba
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

hibba Contributor

hibba

Posted
Posted (edited)

Hello everyone,

 

i need LISP for continue dimension with aligned option. in reference image, there are 2 options A & B. i am getting option B with continues dimension but i required option A.

 

;; DimAlignedContinue ;;

 

(defun c:DAC ( / *error* doc point1 point2 )

(defun *error* (msg)

(if (and msg

(not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))

)

(princ (strcat "\nError: " msg))

)

(if doc

(vla-endundomark doc)

)

(princ)

) ;_ end of defun

 

(setq doc (vla-get-activedocument (vlax-get-acad-object)))

(vla-startundomark doc)

 

(setq point1 (getpoint "\nSpecify first extension line origin:"))

(while

(setq point2 (getpoint "\nSpecify second extension line origin:"))

(command "_.dimaligned" point1 point2 pause)

(setq point1 point2)

) ;_ end of while

(vla-endundomark doc)

(princ)

) ;_ end of defun

(vl-load-com)

01.jpg

Edited by hibba
with solving quote
rashidsohail13 Rookie

rashidsohail13

Posted
Posted

its out of your question but i have other lisp its work for only Polyline on Different Angel.

its not work for points to point. only for polyline select one time and create all dimension in once time.

(PDIM)

 

 

(defun c:pdim(/ plSet pLlst vLst oldOsn cAng cDis cPt)

(princ "\n>> ")

(if(setq plSet(ssget '((0 . "LWPOLYLINE"))))

(progn

(setq pLlst(vl-remove-if 'listp

(mapcar 'cadr(ssnamex plSet))))

(setvar "OSMODE" 0)(setvar "CMDECHO" 0)

(foreach pl pLlst

(setq vLst(mapcar 'cdr

(vl-remove-if-not

'(lambda(x)(= 10(car x)))(entget pl)))

oldOsn(getvar "OSMODE")

); end setq

(while(

(setq cAng(angle(car vLst)(cadr vLst))

cDis(/(distance(car vLst)(cadr vLst))2)

cPt(polar(polar(car vLst)cAng cDis)

(+ cAng(/ pi 2))(* 2(getvar "DIMTXT")))

); end setq

(command "_.dimaligned"(car vLst)(cadr vLst) cPt)

(setq vLst(cdr vLst))

); end while

); end foreach

(setvar "OSMODE" oldOsn)(setvar "CMDECHO" 1)

); end progn

); end if

(princ)

); end of c:pdim

hibba Contributor

hibba

Posted
  • Author
Posted

thanks Mr. rashid for you suggestion. but I was hoping there was an easier way.. I have to select the lots of points and then pick what side I want my

dimensions

marko_ribar Veteran

marko_ribar

Posted
Posted

Here is my version of PDIM... It works for LWPOLYLINE(s) and have option for "INSIDE" - "OUTSIDE"...

 

(defun c:pdim ( / ListClockwise-p ch plSet pLlst vLst oldOsn cAng cDis cPt )

 (defun ListClockwise-p ( lst / z vlst )
   (vl-catch-all-apply 'minusp 
     (list
       (if 
         (not 
           (equal 0.0
             (setq z
               (apply '+
                 (mapcar 
                   (function
                     (lambda (u v)
                       (- (* (car  u) (cadr  v)) (* (car  v) (cadr  u)))
                     )
                   )
                   (setq vlst
                     (mapcar
                       (function
                         (lambda (a b) (mapcar '- b a))
                       )
                       (mapcar (function (lambda (x) (car lst))) lst) 
                       (cdr (reverse (cons (car lst) (reverse lst))))
                     )
                   )
                   (cdr (reverse (cons (car vlst) (reverse vlst))))
                 )
               )
             ) 1e-6
           )
         )
         z
         (progn
           (prompt "\n\nChecked vectors are colinear - unable to determine clockwise-p of list")
           nil
         )
       )
     )
   )
 )

 (initget 1 "Outside Inside")
 (setq ch (getkword "\nChoose on which side to put dimensions [Outside/Inside] : "))
 (princ "\n<<< Select LwPolyline(s) for dimensioning >>> ")
 (if (setq plSet (ssget '((0 . "LWPOLYLINE"))))
   (progn
     (setq pLlst (vl-remove-if 'listp
                        (mapcar 'cadr(ssnamex plSet)))
           oldOsn (getvar "OSMODE")
     ); end setq
     (setvar "OSMODE" 0) (setvar "CMDECHO" 0)
     (command "_.undo" "_be")
     (foreach pl pLlst
      (setq vLst (mapcar '(lambda( x ) (trans x 0 1)) 
                   (mapcar 'cdr (vl-remove-if-not '(lambda( x ) (= 10 (car x)))
                                  (entget pl)
                                )
                   )
                 )
      ); end setq
      (if (equal (logand (cdr (assoc 70 (entget pl))) 1) 1)
       (setq vLst (append vLst (list (car vLst))))
      ); end if
      (if (not (ListClockwise-p vLst)) (setq vLst (reverse vLst)))
      (while (< 1 (length vLst))
       (setq cAng (angle (car vLst) (cadr vLst))
               cDis (/ (distance (car vLst) (cadr vLst)) 2.0)
       )
;        (if (>= (caar vLst) (caadr vLst))
;         (setq cAng (- cAng pi))
;        ); end if
       (if (eq ch "Inside")
        (setq cPt (polar (polar (car vLst) cAng cDis) (- cAng (* 0.5 pi)) (* 2.5 (getvar "DIMTXT")))); end setq
        (setq cPt (polar (polar (car vLst) cAng cDis) (+ cAng (* 0.5 pi)) (* 2.5 (getvar "DIMTXT")))); end setq
       ); end if
       (command "_.dimaligned" (car vLst) (cadr vLst) cPt)
       (setq vLst (cdr vLst))
      ); end while
     ); end foreach
     (command "_.undo" "_e")
     (setvar "OSMODE" oldOsn) (setvar "CMDECHO" 1)
   ); end progn
 ); end if
 (princ)
); end of c:pdim

 

HTH, M.R.

PDuMont Enthusiast

PDuMont

Posted
Posted (edited)

Hi hibba,

 

See if this works for you.

Use it just like the standard dimcontinue:

 

;; DimAlignedContinue ;;

(defun c:DAC ( / *error* doc point1 point2 )
   (defun *error* (msg)
   (if	(and msg
     (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
)
     (princ (strcat "\nError: " msg))
   )
   (if doc
     (vla-endundomark doc)
     )
   (princ)
 ) ;_ end of defun

 (setq doc (vla-get-activedocument (vlax-get-acad-object)))
 (vla-startundomark doc)
 
 (setq point1 (getpoint "\nSpecify first extension line origin:"))
 (while
   (setq point2 (getpoint "\nSpecify second extension line origin:"))
    (command "_.dimaligned" point1 point2 pause)
    (setq point1 point2)
 ) ;_ end of while
 (vla-endundomark doc)
 (princ)
) ;_ end of defun
(vl-load-com)

Edited by PDuMont
Edited per Tharwat's advice
  • Like 1
Tharwat Grand Master

Tharwat

Posted
Posted 

    (setq point1 nil)
    (setq point1 point2)

 

Hi PDuMont,

 

There is no need to set the variable point1 to nil before assigning it to another value .

PDuMont Enthusiast

PDuMont

Posted
Posted

Hi Tharwat,

 

Yeah, I was unsure of that...

Thanks for the clarification.

hibba Contributor

hibba

Posted
  • Author
Posted
Here is my version of PDIM... It works for LWPOLYLINE(s) and have option for "INSIDE" - "OUTSIDE"...

 

(defun c:pdim ( / ListClockwise-p ch plSet pLlst vLst oldOsn cAng cDis cPt )

 (defun ListClockwise-p ( lst / z vlst )
   (vl-catch-all-apply 'minusp 
     (list
       (if 
         (not 
           (equal 0.0
             (setq z
               (apply '+
                 (mapcar 
                   (function
                     (lambda (u v)
                       (- (* (car  u) (cadr  v)) (* (car  v) (cadr  u)))
                     )
                   )
                   (setq vlst
                     (mapcar
                       (function
                         (lambda (a b) (mapcar '- b a))
                       )
                       (mapcar (function (lambda (x) (car lst))) lst) 
                       (cdr (reverse (cons (car lst) (reverse lst))))
                     )
                   )
                   (cdr (reverse (cons (car vlst) (reverse vlst))))
                 )
               )
             ) 1e-6
           )
         )
         z
         (progn
           (prompt "\n\nChecked vectors are colinear - unable to determine clockwise-p of list")
           nil
         )
       )
     )
   )
 )

 (initget 1 "Outside Inside")
 (setq ch (getkword "\nChoose on which side to put dimensions [Outside/Inside] : "))
 (princ "\n<<< Select LwPolyline(s) for dimensioning >>> ")
 (if (setq plSet (ssget '((0 . "LWPOLYLINE"))))
   (progn
     (setq pLlst (vl-remove-if 'listp
                        (mapcar 'cadr(ssnamex plSet)))
           oldOsn (getvar "OSMODE")
     ); end setq
     (setvar "OSMODE" 0) (setvar "CMDECHO" 0)
     (command "_.undo" "_be")
     (foreach pl pLlst
      (setq vLst (mapcar '(lambda( x ) (trans x 0 1)) 
                   (mapcar 'cdr (vl-remove-if-not '(lambda( x ) (= 10 (car x)))
                                  (entget pl)
                                )
                   )
                 )
      ); end setq
      (if (equal (logand (cdr (assoc 70 (entget pl))) 1) 1)
       (setq vLst (append vLst (list (car vLst))))
      ); end if
      (if (not (ListClockwise-p vLst)) (setq vLst (reverse vLst)))
      (while (< 1 (length vLst))
       (setq cAng (angle (car vLst) (cadr vLst))
               cDis (/ (distance (car vLst) (cadr vLst)) 2.0)
       )
;        (if (>= (caar vLst) (caadr vLst))
;         (setq cAng (- cAng pi))
;        ); end if
       (if (eq ch "Inside")
        (setq cPt (polar (polar (car vLst) cAng cDis) (- cAng (* 0.5 pi)) (* 2.5 (getvar "DIMTXT")))); end setq
        (setq cPt (polar (polar (car vLst) cAng cDis) (+ cAng (* 0.5 pi)) (* 2.5 (getvar "DIMTXT")))); end setq
       ); end if
       (command "_.dimaligned" (car vLst) (cadr vLst) cPt)
       (setq vLst (cdr vLst))
      ); end while
     ); end foreach
     (command "_.undo" "_e")
     (setvar "OSMODE" oldOsn) (setvar "CMDECHO" 1)
   ); end progn
 ); end if
 (princ)
); end of c:pdim

 

HTH, M.R.

 

Thanks MR Marko, this is helpful for me...

hibba Contributor

hibba

Posted
  • Author
Posted (edited)
Hi hibba,

 

See if this works for you.

Use it just like the standard dimcontinue:

 

;; DimAlignedContinue ;;

(defun c:DAC ( / *error* doc point1 point2 )
   (defun *error* (msg)
   (if	(and msg
     (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
)
     (princ (strcat "\nError: " msg))
   )
   (if doc
     (vla-endundomark doc)
     )
   (princ)
 ) ;_ end of defun

 (setq doc (vla-get-activedocument (vlax-get-acad-object)))
 (vla-startundomark doc)
 
 (setq point1 (getpoint "\nSpecify first extension line origin:"))
 (while
   (setq point2 (getpoint "\nSpecify second extension line origin:"))
    (command "_.dimaligned" point1 point2 pause)
    (setq point1 point2)
 ) ;_ end of while
 (vla-endundomark doc)
 (princ)
) ;_ end of defun
(vl-load-com)

 

Thanks so much Mr. PDuMont, this is exactly what i want... this is working fine for me :)

Edited by hibba
  • Like 1
rashidsohail13 Rookie

rashidsohail13

Posted
Posted

Thanks

Great Work

Now i work more better and Fast Again Thanks.

PDuMont Enthusiast

PDuMont

Posted
Posted
Thanks so much Mr. PDuMont, this is exactly what i want... this is working fine for me :)

 

You're very welcome.

 

I've received great help, and have learned a lot here, so it's nice to give back.

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.

×
 Share
Go to topic listing
×
×
  • Create New...