Jump to content

[HELP] Dimension Extension Line overlapping


haisagiviz

Recommended Posts

Hi everyone,

I have a lisp to Move all of dimension point to itself base line from @Roy_043 before.

The lisp is working for me and can move all of Def points of dimension to base line.

But for more in the drawings, I need to move only Dim Points which are only overlap on other center line (such as line, polyline, rectangle edge...)

image.thumb.png.ffb6e5c03dc7051f7f17b0b4dc0e7c2e.png

Please download attached file.

Thank you so much.

HAI

_PutDefPointsOnDimLine.lsp

Link to comment
Share on other sites

dim.dwg

 

It probably doesn't do all you want, but here's a start.

It works only for horizontal dimensions.

If the first extension line origin of obj1 = the second extension line origin of obj2 => then it will push both points down to the y-value of the dimension line.

 

Try it on my file first, then see if it fits your needs, let me know.

 


;; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/change-the-value-of-a-assoc/td-p/8738111
;; modify 1 property of an object
(defun entmod_property (psn tag YourNewValue / )
  (entmod (setq psn (subst (cons tag YourNewValue) (assoc tag psn) psn)))
)
 
(defun c:test ( / obj ent)
  (setq ent (entget
    (setq obj (car (entsel)))
  ))
  (entmod_property ent 14 (list 10. -4.))
)

(defun samepoint (p1 p2 / small_number)
  (setq small_number 0.01)
  (< (distance p1 p2) small_number)
)

;; Move Def point on Dimension line when Overlap
(defun c:mddo ( / ss i j item item2 obj obj2 ent ent2 datalist)
  (princ "\nSelect dim objects: ")
  (setq ss (ssget (list (cons 0 "DIMENSION"))))
  (setq i 0)
  (setq datalist (list))
  (repeat (sslength ss)
    
    (setq obj (ssname ss i))
    (setq ent (entget obj))
    
    (setq datalist (append datalist (list
      (list
        (cdr (assoc 13 ent))  ;; left arm
        (cdr (assoc 14 ent))  ;; right arm
        (cdr (assoc 10 ent))  ;; bottom position
      )
    )))
    
    (setq i (+ i 1))
  )
  ;; now let's analyze the data
  (setq i 0)
  (foreach item datalist
 
    (setq obj (ssname ss i))
    (setq ent (entget obj))
 
    (setq j (+ i 1))  
    (while (setq item2 (nth j datalist))

      (setq obj2 (ssname ss j))
      (setq ent2 (entget obj2))
      
      ;; look if the first extension line origin of obj1 = the second extension line origin of obj2
      (if
        (samepoint (nth 0 item) (nth 1 item2))
        (progn
          (entmod_property ent 13 (list
            (nth 0 (nth 0 item)) (nth 1 (nth 2 item))    ;; x position stays, y position of bar gets taken
          ))
          (entmod_property ent2 14 (list
            (nth 0 (nth 1 item2)) (nth 1 (nth 2 item2))  ;; x position stays, y position of bar gets taken
          ))
        )
      )
      (setq j (+ j 1))
    )
    (setq i (+ i 1))
  )
)

  • Thanks 1
Link to comment
Share on other sites

  • 4 months later...

Dear @Emmanuel Delay,

 

Thank for your support.

Sorry for late because I just want to learn something about basic Autolisp before start with it.

 

I used MDDO command and tested your lisp but it is not working well. It worked but almost of dimensions went wrong.

Please confirm again in my attached drawing.
 

Thank you so much.

HAI

Test Drawing.dwg

Edited by haisagiviz
Attached the drawing file.
Link to comment
Share on other sites

  • haisagiviz changed the title to [HELP] Dimension Extension Line overlapping

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...