Dimension disconnect

[andy_lee]

This is the effect of need :

 

But, the reality is like this:

 

Would also like this :

 

Hi guys! I need some help !

 

(vl-load-com)
(defun c:test (/ n x ent entL p2 p3 px1 px2 py1 py2 ptdd xl sa pt0 ppt ptdd)
(setvar "cmdecho" 0)
(command "undo" "be")
(setq entL '())
(if (setq ent (centsel "\nChoose Dimension or <EXIT>:" "DIMENSION"))
  (progn
    (setq x (entget ent)
       entL (cons ent entL)
         p2 (dxf 13 x)
         p3 (dxf 14 x)
         px1 (list (car p2) (/ (+ (cadr p2)(cadr p3)) 2.0))
         px2 (list (car p3) (/ (+ (cadr p2)(cadr p3)) 2.0))
         py1 (list (/ (+ (car p2)(car p3)) 2.0) (cadr p2))
         py2 (list (/ (+ (car p2)(car p3)) 2.0) (cadr p3))
         ptdd (list p2 p3)
         XL (entget (dxf -2 (tblsearch "block" (dxf 2 x))))
         SA (abs (sin (angle (dxf 10 xl) (dxf 11 xl)))))
  (while (setq pt0 (getpoint "\nPick point or <EXIT>:"))
      (command ".copy" ent "" "0,0" "@")
      (setq entL (cons (entlast) entL))
   (cond
     ((equal SA 1 1e-6) ;;horizonta
        (setq ptdd (cons (ptper pt0 px1 px2) ptdd)
                ppt (Lsort ptdd 0))
       )
     ((equal SA 0 1e-6) ;;vertical 
        (setq ptdd (cons (ptper pt0 py1 py2) ptdd)
               ppt (Lsort ptdd 1))
      )
      (t (setq ptdd (cons (ptper pt0 p2 p3) ptdd)
           ppt (Lsort ptdd 2)))
     )
      (setq ppL (mapcar 'list ppt (cdr ppt))
             n 0)
        (repeat (length ppL)
          (setq xf (entget (nth n entL))
               nxf (subst (cons 13 (car  (nth n ppL)))(assoc 13 xf) xf)
               wxf (subst (cons 14 (cadr (nth n ppL)))(assoc 14 nxf) nxf)
               n (1+ n))
          (entmod wxf)
        )
    ))
 (princ "\nEXIT")
)
 (command "undo" "e") (setvar "cmdecho" 1)
 (princ)
)
(defun centsel (msg f)
(while (if (setq el (car (entsel msg))) (if (= (cdr (assoc 0 (entget el))) f) nil t) nil)) el
)
;;dxf
(defun dxf (x e)(cdr (assoc x e)))
;;pedal
(defun ptper (pt0 pt1 pt2)
(inters pt0 (polar pt0 (+ (angle pt1 pt2) (/ pi 2)) 1.0) pt1 pt2 nil)
)
;;sorting  0 horizonta 1 vertical 2 Oblique
(defun Lsort (LT i)
(cond
((or (= i 0)(= i 2))(setq Lt (vl-sort LT (function (lambda (e1 e2)(< (car e1) (car e2)))))))
((or (= i 1)(= i 2))(setq Lt (vl-sort LT (function (lambda (e1 e2)(< (cadr e1) (cadr e2)))))))
))
(princ)

[BIGAL]

I did not run code but maybe a different approach taking two versions HOR & VER, Pick stpt next next next next endpt then pick a point for the adjusted level of the intermediate dims and final top level. So you have a pt list you know 1st and last then run dim command just using a loop for start and end pts. This way draw dims as you go rather than adjust.

[7o7]

You change this paragraph:

 (cond
  ((equal SA 1 1e-6)
   ;;horizonta
   (setq ptdd (cons pt0 ptdd) 
	 ppt  (Lsort ptdd 0)
   )
  )
  ((equal SA 0 1e-6)
   ;;vertical 
   (setq ptdd (cons pt0 ptdd) 
	 ppt  (Lsort ptdd 1)
   )
  )
  (t
   (setq ptdd (cons pt0 ptdd) 
	 ppt  (Lsort ptdd 2)
   )
  )
)

[andy_lee]

You change this paragraph:

 

OK! Thank you sir.

But,dimension becomes high and low.

 

[7o7]

It depends on your dimstyle setting. Can you upload your file with dimstyles?

[andy_lee]

It depends on your dimstyle setting. Can you upload your file with dimstyles?

 

Dear sir

Thanks , The dimstyles is default . I use New document.

test.dwg

[7o7]

You have to change also this paragraph:

(setq ppL (mapcar 'list ppt (cdr ppt))	      
      n	  0
      tt10 (cdr (assoc 10 (entget (nth n entL))))
)
(repeat	(length ppL)
  (setq	xf  (entget (nth n entL))
	nxf (subst (cons 13 (car (nth n ppL))) (assoc 13 xf) xf)
	wxf (subst (cons 14 (cadr (nth n ppL))) (assoc 14 nxf) nxf)
	wxf (subst (cons 10 tt10) (assoc 10 wxf) wxf)
	n   (1+ n)
  )
  (entmod wxf)
)

[Tharwat]

Use the command: dimcontinue

[andy_lee]

You have to change also this paragraph:

 

Dear sir.

I really appreciate the help. I tested yet .Very good! Admire you!

here is another, Dimension merge, multiple merged into one .

But need dimension aligned ia a line, Otherwise,can't merge.

As shown in the image below .

The first case can merge.

The second case can't merge,because the dimension not aligned.

 

need if not aligned, still can merge.

(defun c:test( / ss ic xic aa bb n ent1)
(setvar "cmdecho" 0)
(command "undo" "be")
(princ "\nPlease choose dimension for merge ")
(setq ss (ssget '((0 . "DIMENSION")))
     sumn (sslength ss) n 0 xss '() aa '())
(repeat sumn (setq xss (cons (ssname ss n) xss) n (1+ n)))
(while (car xss)
 (setq bb '()
       bb (cons (car xss) bb)
       ic (getxx (entget (car xss)))
       xss (cdr xss) 
       yss xss)
 (while (car yss)
   (setq ent1 (car yss)
          xic (getxx (entget ent1)))
    (if (apply 'and (mapcar '(lambda(x y)(equal x y 1e-5)) xic ic))
        (setq bb (cons ent1 bb)
             xss (vl-remove ent1 xss)))
        (setq yss (cdr yss)))
  (setq aa (cons bb aa))
)
(setq n 0)
(repeat (length aa)
 (setq ent1 (nth n aa) n (1+ n))
 (if (cdr ent1)(progn
   (setq ptx (getmxy ent1)
         xf (entget (car ent1))
        nxf (subst (cons 13 (car  ptx))(assoc 13 xf) xf)
        wxf (subst (cons 14 (cadr ptx))(assoc 14 nxf) nxf)
         xx (cdr ent1))
   (entmod wxf)
   (while xx (entdel (car xx)) (setq xx (cdr xx)))
 ))
)
(command "undo" "e") (setvar "cmdecho" 1)
(princ)
)
(defun dxf (x e)(cdr (assoc x e)))
(defun getxx(x / xy xl a b bb)
(setq xy (dxf 10 x)
     xl (entget (dxf -2 (tblsearch "block" (dxf 2 x))))
      A (angle (dxf 10 xl) (dxf 11 xl)))
(cond
  ((equal (abs (sin A)) 1 1e-6) ;;horizonta
     (list (cadr xy) (sin A)))
  ((equal (sin A) 0 1e-6) ;;vertical 
     (list (car xy) (sin A)))
  (t (setq B (+ A (* 0.5 pi))
          bb (- (cadr xy) (* (/ (sin B)(cos B)) (car xy))))
     (list bb (sin A)))
 )
)
(defun getmxy(ssent / ptx xx yy A xl sa)
(foreach x ssent
   (setq ptx (cons (dxf 13 (entget x)) ptx)
         ptx (cons (dxf 14 (entget x)) ptx)))
(setq xl (entget (dxf -2 (tblsearch "block" (dxf 2 (entget (car ssent))))))
      A (angle (dxf 10 xl) (dxf 11 xl)))
(cond
     ((equal SA 1 1e-6) (setq ppt (Lsort ptx 0)))
     ((equal SA 0 1e-6) (setq ppt (Lsort ptx 1)))
      (t (setq ppt (Lsort ptx 2)))
 )(list (car ppt)(last ppt))
)
(defun Lsort (LT i)
(cond
((or (= i 0)(= i 2))(setq Lt (vl-sort LT (function (lambda (e1 e2)(< (car e1) (car e2)))))))
((or (= i 1)(= i 2))(setq Lt (vl-sort LT (function (lambda (e1 e2)(< (cadr e1) (cadr e2)))))))
))
(princ)

[andy_lee]

Use the command: dimcontinue

 

Dear Tharwat. thank you! I know "dimcontinue"

[7o7]

You delete 2 lines of your code, it will work.

(while (car xss)
 (setq bb '()
       bb (cons (car xss) bb)
       ic (getxx (entget (car xss)))
       xss (cdr xss) 
       yss xss)
 (while (car yss)
   (setq ent1 (car yss))
;;;           xic (getxx (entget ent1)))
;;;     (if (apply 'and (mapcar '(lambda(x y) (equal x y 1e-5)) xic ic))
        (setq bb (cons ent1 bb)
             xss (vl-remove ent1 xss))
        (setq yss (cdr yss)))
  (setq aa (cons bb aa))
)

[andy_lee]

You delete 2 lines of your code, it will work.

 

Dear sir.

very good, Thank you very much!

[7o7]

You are welcome Andy_Lee.