Author Topic: move grips  (Read 2239 times)

0 Members and 1 Guest are viewing this topic.

Fabricio28

  • Swamp Rat
  • Posts: 666
move grips
« on: November 08, 2013, 07:40:08 AM »
Hi guys!
How are you?

My project was changed and I have to move all polyline's grips into the center of my blocks.
It's a really tough doing that manually.

So, I come here to ask someone help me.
I have a little example of my task in the attached file, please take a look.

Thank in advance

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: move grips
« Reply #1 on: November 08, 2013, 11:24:28 AM »
Try this, and in your case tolerance could be 0.5...

Code: [Select]
(defun c:calibrate2dplgripstoblocksinsertions (/ ss ssbl i bl ptbl ptbll tol pl plf vert pt ptn)
  (command "_.zoom" "e")
  (command "_.zoom" "0.5xp")
  (prompt "\nSelect 2dpolylines to calibrate their grips")
  (setq ss (ssget "_:L" (list '(0 . "*POLYLINE") '(-4 . "<not") '(-4 . "&=") '(70 . 8) '(-4 . "not>"))))
  (setq ssbl (ssget "_W" (getvar 'extmin) (getvar 'extmax) '((0 . "INSERT"))))
  (setq i -1)
  (while (setq bl (ssname ssbl (setq i (1+ i))))
    (setq ptbl (cdr (assoc 10 (entget bl))))
    (setq ptbll (cons ptbl ptbll))
  )
  (initget 7)
  (setq tol (getdist "\nSpecify tolerance value - little greater than distance between grip and block insertion: "))
  (setq i -1)
  (while (setq pl (ssname ss (setq i (1+ i))))
    (if (eq (cdr (assoc 0 (entget pl))) "LWPOLYLINE") (progn (command "_.convertpoly" "h" pl "") (setq plf T)) (setq plf nil))
    (setq vert pl)
    (while (and (setq vert (entnext vert)) (eq (cdr (assoc 0 (entget vert))) "VERTEX"))
      (setq pt (cdr (assoc 10 (entget vert))))
      (setq ptn (car (vl-sort ptbll '(lambda (a b) (< (distance pt a) (distance pt b))))))
      (if (> (distance pt ptn) tol) (setq ptn pt))
      (entmod (subst (cons 10 ptn) (cons 10 pt) (entget vert)))
      (entupd (cdr (assoc -1 (entget vert))))
    )
    (if plf (command "_.convertpoly" "l" pl ""))
  )
  (princ)
)

(defun c:cplbl nil (c:calibrate2dplgripstoblocksinsertions))
(prompt "\n...Invoke with 'CPLBL'...")
(princ)

M.R.
« Last Edit: November 08, 2013, 11:56:53 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ronjonp

  • Needs a day job
  • Posts: 7526
Re: move grips
« Reply #2 on: November 08, 2013, 11:30:54 AM »
Here's my version.

Code: [Select]

(defun c:foo (/ _dxf _emodeqpoint _ss->list blks e fuzz p p1 p2 pt pts ss tmp x)
  (defun _ss->list (ss / n result)
    (if (= (type ss) 'pickset)
      (repeat (setq n (sslength ss)) (setq result (cons (ssname ss (setq n (1- n))) result)))
    )
  )
  (defun _emodeqpoint (ename p1 p2 fuzz)
    (if (and ename (= (type ename) 'ename))
      (entmod (mapcar '(lambda (x)
(if (and (= (car x) 10) (equal x (list 10 (car p1) (cadr p1)) fuzz))
   (list 10 (car p2) (cadr p2))
   x
)
       )
      (entget ename)
      )
      )
    )
  )
  (defun _dxf (code ename)
    (if (and ename (= (type ename) 'ename))
      (cdr (assoc code (entget ename '("*"))))
    )
  )
  (if (and (setq e (car (entsel "\nSelect a BLOCK to snap polyline(s) to:")))
   (= (_dxf 0 e) "INSERT")
   (setq fuzz (getdist "\nPick fuzz distance: "))
      )
    (if (setq ss (_ss->list (ssget (list '(0 . "lwpolyline")))))
      (progn (setq blks (ssget "_X" (list '(0 . "insert") (cons 2 (_dxf 2 e)))))
     (setq blks (mapcar '(lambda (x) (_dxf 10 x)) (_ss->list blks)))
     (foreach pl ss
       (setq pts (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget pl))))
       (foreach pt pts
(setq tmp (mapcar '(lambda (x) (list (distance pt x) x)) blks))
(setq tmp (car (vl-sort tmp '(lambda (d1 d2) (< (car d1) (car d2))))))
(if (<= (car tmp) fuzz)
   (progn (_emodeqpoint pl pt (cadr tmp) fuzz)
  (entmakex (list '(0 . "CIRCLE")
  (cons 8 "_modified")
  (cons 10 (cadr tmp))
  (cons 40 (* 4. fuzz))
    )
  )
   )
)
       )
     )
      )
    )
  )
  (princ)
)
« Last Edit: November 08, 2013, 11:35:34 AM by ronjonp »

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

roy_043

  • Water Moccasin
  • Posts: 1895
  • BricsCAD 18
Re: move grips
« Reply #3 on: November 08, 2013, 11:52:25 AM »
... And my version (tested on BricsCAD).

Note this issue may still apply for AutoCAD:
http://www.theswamp.org/index.php?topic=28706.0

Code: [Select]
(defun KGA_Conv_Pickset_To_EnameList (ss / i ret)
  (if ss
    (repeat (setq i (sslength ss))
      (setq ret (cons (ssname ss (setq i (1- i))) ret))
    )
  )
)

(defun c:test ( / currentPolyPoint diameter idx polyElist polyEname polyObject insertEnamelist insertPointList)
  (setq diameter 0.6) ; Diameter of "SIMB_BOLINHA".
  (if (setq polyEname (car (entsel "Select polyline: ")))
    (progn
      (setq polyElist (entget polyEname))
      (setq polyObject (vlax-ename->vla-object polyEname))
      (setq insertEnamelist
        (KGA_Conv_Pickset_To_Enamelist
          (ssget
            "_F"
            (vl-remove; Using points from poly for a fence.
              nil
              (mapcar
                '(lambda (a) (if (= (car a) 10) (cdr a)))
                polyElist
              )
            )
            '((0 . "INSERT") (2 . "SIMB_BOLINHA"))
          )
        )
      )
      (setq insertPointList
        (mapcar
          '(lambda (a)
            (cdr (assoc 10 (entget a)))
          )
          insertEnamelist
        )
      )
      (setq idx -1)
      (repeat (cdr (assoc 90 polyElist))
        (setq idx (1+ idx))
        (setq currentPolyPoint (vlax-get polyObject 'coordinate idx))
        (vl-some
          '(lambda (insertPoint)
            (if (< (distance insertPoint currentPolyPoint) diameter)
              (progn
                (vlax-put polyObject 'coordinate idx insertPoint)
                T
              )
            )
          )
          insertPointList
        )
      )
    )
  )
  (princ)
)

Fabricio28

  • Swamp Rat
  • Posts: 666
Re: move grips
« Reply #4 on: November 08, 2013, 12:36:48 PM »
Thanks guys, for the quickly replay.


I'm so appreciated for  the all the help.

Thank you very much!
  :-D