Reference point for custom coordinates
It is tricky request, but it is solvable. I have more than half a the requested code already written. Just have to play with different box setups and fine-tune it for boxes with width (height) equal 150. Also have to add output to Excel. Would you mind export to .csv or you really need write directly to Excel?
It getting late so I'll try to finish it tomorrow.
Miljenko Hatlak
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
Try this on different box combinations and see if it works correctly. I have no time to conduct thorough testing.
;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/reference-point-for-custom-coordinates/td-p/12593789
;hak_vz 03-03-2024
(defun c:clist ()
(defun LM:selectDynamicBlockByName (ss name / e i out)
(setq i -1 ssout (ssadd))
(while (setq e (ssname ss (setq i (1+ i))))
(if (= :vlax-true (vla-get-IsDynamicBlock (vlax-ename->vla-object e)))
(if (= (strcase (vla-get-Effectivename (vlax-ename->vla-object e))) (strcase name))
(ssadd e ssout)
)
)
)
ssout
)
(defun LM:getattributevalue ( blk tag )
(setq tag (strcase tag))
(vl-some '(lambda ( att )
(if (= tag (strcase (vla-get-tagstring att)))
(vla-get-textstring att)))
(vlax-invoke blk 'getattributes)
)
)
(defun LM:getdynpropvalue ( blk prp )
(setq prp (strcase prp))
(vl-some '(lambda ( x ) (if (= prp (strcase (vla-get-propertyname x))) (vlax-get x 'value)))
(vlax-invoke blk 'getdynamicblockproperties)
)
)
(defun LM:getvisibilitystate ( blk / vis )
(if (setq vis (LM:getvisibilityparametername blk))
(LM:getdynpropvalue blk vis)
)
)
(defun LM:getvisibilityparametername ( blk / vis )
(if
(and
(vlax-property-available-p blk 'effectivename)
(setq blk
(vla-item
(vla-get-blocks (vla-get-document blk))
(vla-get-effectivename blk)
)
)
(= :vlax-true (vla-get-isdynamicblock blk))
(= :vlax-true (vla-get-hasextensiondictionary blk))
(setq vis
(vl-some
'(lambda ( pair )
(if
(and
(= 360 (car pair))
(= "BLOCKVISIBILITYPARAMETER" (cdr (assoc 0 (entget (cdr pair)))))
)
(cdr pair)
)
)
(dictsearch
(vlax-vla-object->ename (vla-getextensiondictionary blk))
"ACAD_ENHANCEDBLOCK"
)
)
)
)
(cdr (assoc 301 (entget vis)))
)
)
(defun LM:writecsv ( lst csv / des sep )
(if (setq des (open csv "w"))
(progn
(setq sep (cond ((vl-registry-read "HKEY_CURRENT_USER\\Control Panel\\International" "sList")) (",")))
(foreach row lst (write-line (LM:lst->csv row sep) des))
(close des)
t
)
)
)
(defun LM:lst->csv ( lst sep )
(if (cdr lst)
(strcat (LM:csv-addquotes (car lst) sep) sep (LM:lst->csv (cdr lst) sep))
(LM:csv-addquotes (car lst) sep)
)
)
(defun LM:csv-addquotes ( str sep / pos )
(cond
( (wcmatch str (strcat "*[`" sep "\"]*"))
(setq pos 0)
(while (setq pos (vl-string-position 34 str pos))
(setq str (vl-string-subst "\"\"" "\"" str pos)
pos (+ pos 2)
)
)
(strcat "\"" str "\"")
)
( str )
)
)
(defun string_to_list ( str del / pos )
(if (setq pos (vl-string-search del str))
(cons (substr str 1 pos) (string_to_list (substr str (+ pos 1 (strlen del))) del))
(list str)
)
)
(setq hor_cord
'(
("1" 25 125)
("2" 125 225)
("3" 225 325)
("4" 325 425)
("5" 425 525)
("6" 525 625)
("7" 625 725)
("8" 725 825)
("9" 825 925)
("10" 925 1025)
("11" 1025 1125)
("12" 1125 1225)
("13" 1225 1325)
("14" 1325 1425)
("15" 1425 1525)
)
)
(setq ver_cord
'(
("A" 25 125)
("B" 125 225)
("C" 225 325)
("D" 325 425)
("E" 425 525)
("F" 525 625)
)
)
(setq ss (LM:selectDynamicBlockByName (ssget "_C" '(0 0) '(1550 650) '((0 . "INSERT"))) "SQARE") i -1 boxes nil)
(while (<(setq i (1+ i)) (sslength ss))
(setq eo (vlax-ename->vla-object (ssname ss i)))
(setq minpt (vlax-get eo 'InsertionPoint))
(setq visibility (string_to_list (LM:getvisibilitystate eo) "x"))
(setq bx (atof(car visibility)))
(setq by (atof(cadr visibility)))
;(princ (strcat "\n" (rtos bx 2 0)"x" (rtos by 2 0)))
(setq boxes (cons (list minpt (mapcar '+ minpt (list bx by))) boxes))
)
(setq ss (ssget "_C" '(0 0) '(1550 650) '((0 . "INSERT")(2 . "circle"))) i -1 loclist nil)
(while (<(setq i (1+ i)) (sslength ss))
(setq co (vlax-ename->vla-object (ssname ss i)))
(setq id (LM:getattributevalue co "ID"))
(setq ip (vlax-get co 'InsertionPoint))
(setq xip (car ip) yip (cadr ip))
(foreach box boxes
(setq p1 (car box) p2 (cadr box))
(setq xmin (car p1) ymin (cadr p1))
(setq xmax (car p2) ymax (cadr p2))
(if (and (> xip xmin)(< xip xmax)(> yip ymin)(< yip ymax))
(setq
refpoint (mapcar '+ '(6 6) p1)
boxsize (list (- xmax xmin)(- ymax ymin))
)
)
)
(foreach loc hor_cord
(if (and (>= xip (cadr loc))(<= xip (caddr loc)))
(setq xloc (list (car loc) xip))
)
)
(foreach loc ver_cord
(if (and (>= yip (cadr loc))(<= yip (caddr loc)))
(setq yloc (list (car loc) yip))
)
)
(setq loclist (cons (list id xloc yloc boxsize refpoint) loclist))
)
(setq ret nil)
(foreach loc loclist
(setq id (car loc)
xloc (assoc(car(cadr loc)) hor_cord)
xrange (cdr xloc)
xloc (car xloc)
xip (cadr(cadr loc))
yloc (assoc(car(caddr loc))ver_cord)
yrange (cdr yloc)
yloc (car yloc)
yip (cadr(caddr loc))
xmid (* 0.5 (apply '+ xrange))
ymid (* 0.5 (apply '+ yrange))
refpoint (last loc)
boxsize (nth 3 loc)
boxwidth (car boxsize)
boxheight (cadr boxsize)
rpx (car refpoint)
rpy (cadr refpoint)
)
(cond
((and (< rpx xmid) (< rpy ymid)) (setq rp "1"))
((and (>= rpx xmid) (< rpy ymid)) (setq rp "2"))
((and (< rpx xmid) (> rpy ymid)) (setq rp "3"))
((and (>= rpx xmid) (> rpy ymid)) (setq rp "4"))
)
(if (and (>= boxwidth 100)(>= boxheight 100))(setq rp ""))
(if (>(strlen rp) 0) (setq xloc (strcat xloc "." rp)))
(setq ret (cons (list id (strcat yloc xloc)) ret))
)
(setq ret (append '((" ")) (vl-sort ret '(lambda (x y)(< (atoi (car x))(atoi (car y)))))))
(if
(and
(setq fn (getfiled "Create Output File" "" "csv" 1))
)
(progn
(if (LM:WriteCSV ret fn)
(startapp "explorer" fn)
)
)
)
(princ)
)
Miljenko Hatlak
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
Program will work if following conditions are true:
1) Origin of the grid is at point 0,0 and grid is not selected
2) Modify variables hor_cord and ver_cord i.e add additional ranges according to your need since I didn't play with scales of blocks. Keep it in this sizes.
(setq hor_cord
'(
("1" 25 125)
("2" 125 225)
("3" 225 325)
("4" 325 425)
("5" 425 525)
("6" 525 625)
("7" 625 725)
("8" 725 825)
("9" 825 925)
("10" 925 1025)
("11" 1025 1125)
("12" 1125 1225)
("13" 1225 1325)
("14" 1325 1425)
("15" 1425 1525)
)
)3)If you need to add more box type retain block names as current
Miljenko Hatlak
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
I'll modify code so that you can enter grid size and that this variables are auto created. First play with this grid but with different box sizes and orientations.
I have assumed that large boxes that take more then one grid unit (100X100 150X150)are placed origin i.e. in field 1 and small boxes are added around them. When you do some testings and in next iterations we can add other options and improvements.
Miljenko Hatlak
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
IMO you can create largest grid that you plan to use. Update hor and ver variable to have all ranges and it will work with all smaller one. Also change
(ssget "_C" '(0 0) '(1550 650)where 1550, 650 is inside coordinate of right top corner of the grid. Code after it finishes and create return list calls Excel to write result in csv file.
Miljenko Hatlak
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
I actually liked working on this task. This looks to me as a good method to organize boxes with rarely used stuff stored in my cellar.
Miljenko Hatlak
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
