TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: Fabricio28 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
-
Try this, and in your case tolerance could be 0.5...
(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.
-
Here's my version.
(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)
)
-
... And my version (tested on BricsCAD).
Note this issue may still apply for AutoCAD:
http://www.theswamp.org/index.php?topic=28706.0
(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)
)
-
Thanks guys, for the quickly replay.
I'm so appreciated for the all the help.
Thank you very much!
:-D