continue Dimension with aligned option Lisp required

[hibba]

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)

Edited December 16, 2015 by hibba
with solving quote

[rashidsohail13]

good

i face same problem

[rashidsohail13]

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]

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]

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]

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 December 15, 2015 by PDuMont
Edited per Tharwat's advice

[Tharwat]

    (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]

Hi Tharwat,

 

Yeah, I was unsure of that...

Thanks for the clarification.

[hibba]

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]

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 December 16, 2015 by hibba

[rashidsohail13]

Thanks

Great Work

Now i work more better and Fast Again Thanks.

[PDuMont]

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.