Author Topic: measure command  (Read 170 times)

0 Members and 1 Guest are viewing this topic.

milanp

  • Mosquito
  • Posts: 9
measure command
« on: November 08, 2018, 04:35:57 PM »
Hi! I use this code for a long time and everything works great but ...If the lines are too close or intersect, there is a problem. Blocks on the first line take on properties of other blocks on the second line that is close or intersect with the first one. I hope you understand what I mean. Does anyone understand why this is happening? I did not write the code myself. Thanks


 
Code: [Select]
(vl-load-com)
 
(defun C:MBL ( / obj bname odist scale p_ent c_lay p_obj minExt maxExt i_obj ss ans)
 
  (cond
    ((and (setq obj (vlax-ename->vla-object (car (entsel "\nSelect Block Entity: "))))
  (eq (vla-get-objectname obj) "AcDbBlockReference")
  (setq bname (if (vlax-property-available-p obj 'effectivename)
(vla-get-effectivename obj)
(vla-get-name obj)
      )
  )
  (princ (strcat "\nBlock Name : " bname))
     )
 
     (setq odist (getdist "\nEnter Distance between Blocks :"))
     (setq scale (getreal "\nEnter Scale for Blocks : "))
 
     (while (setq p_ent (car (entsel "\nSelect polyline: ")))
       (setq c_lay (getvar 'clayer))
       (setq p_obj (vlax-ename->vla-object p_ent))
       (vla-GetBoundingBox p_obj 'minExt 'maxExt)
       (command "_measure" p_ent "_b" bname "_y" odist)
       (if
(ssget "_C"
(vlax-safearray->list minExt)
(vlax-safearray->list maxExt)
(list (cons 0 "INSERT") (cons 8 c_lay) (cons 2 bname))
)
  (progn
    (vlax-for i_obj (setq ss (vla-get-activeselectionset
       (vla-get-activedocument
(vlax-get-acad-object)
       )
     )
    )
      (vla-put-xscalefactor i_obj scale)
      (vla-put-yscalefactor i_obj scale)
      (vla-put-zscalefactor i_obj scale)
    )
    (initget "Yes No")
    (setq ans (getkword "\nRotate Blocks 180? [Yes No] : "))
    (if (= ans "Yes")
      (vlax-for i_obj ss
(vla-put-rotation i_obj (+ pi (vla-get-rotation i_obj)))
      )
    )
    (vla-delete ss)
  )
       )
     )
    )
  )
  (princ)


Dlanor

  • Newt
  • Posts: 114
Re: measure command
« Reply #1 on: November 08, 2018, 07:18:33 PM »
Why is because when you select the polyline the routine gets the bounding box of the polyline (minExt & MaxExt), then uses these coords as the extents of a box (ssget "_C")  to select all blocks on the current layer and the supplied name within or crossing this selection box.

Perhaps a "F" (fence) selection would be better; but not foolproof, if other non required blocks are intersecting the polyline.

ribarm

  • Water Moccasin
  • Posts: 1917
  • Marko Ribar, architect
Re: measure command
« Reply #2 on: November 08, 2018, 11:15:55 PM »
Bolje of "F" fence opcije je da pre pozivanja komande "measure", deklarises varijablu (setq el (entlast))... Posle zavrsetka komande "measure", iteriraj databazu na nove entitete (while (setq el (entnext el)) ... ovde dodaj nove 'el' entitete u selekcijski set koji je pre (while) deklarisan sa (setq ss (ssadd))... Dodavanje se vrsi funkcijom (ssadd el ss)... Zatvori (while loop sa zagradom ')' i umesto (ssget "_C" minpt maxpt filter) - minpt maxpt - tacke bounding box-a referentne polilinije, imaces sigurnije kreiran ss sa novim blokovima - entitetima koje takodje mozes da modifikujes naknadno na scale factor-e i rotaciju... Ako si pretvorio standardni selekcijski set ss u vla-object sa (setq ss (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object)))), na kraju rutine ga izbrisi sa (vla-delete ss) - u svakom slucaju bi trebalo da ga imas lokalizovano posle prve linije (defun c:tralala ( / ss el ) ... (princ))
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

Dlanor

  • Newt
  • Posts: 114
Re: measure command
« Reply #3 on: November 09, 2018, 06:14:16 AM »
OK. Try this re written lisp. It uses a dynamic prompt for the Yes/No to rotate the blocks so you can select with the mouse.
It places the blocks in the current layer. If you want something changing let me know.

Code - Auto/Visual Lisp: [Select]
  1. ;;; Ron Harman
  2.  
  3. (defun C:MBL ( / dynp dynm c_doc ms ent b_obj b_name t_dist b_dist b_size l_obj l_len i_pt r_ang n_obj b_lst ans)
  4.  
  5.  (defun *error* ( msg )
  6.    (setvar 'dynprompt dynp)
  7.    (setvar 'dynmode dynm)
  8.    (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
  9.    (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nAn Error : " msg " occured.")))
  10.    (princ)
  11.  );_end_*error*_defun
  12.  
  13.  (setq dynp (getvar 'dynprompt)
  14.        dynm (getvar 'dynmode)
  15.  );end_setq
  16.  
  17.  (setvar 'dynprompt 1)
  18.  (setvar 'dynmode 3)
  19.  
  20.        ms (vla-get-modelspace c_doc)
  21.  
  22.  );end_setq
  23.  
  24.  (while (not b_obj)
  25.    (setq ent (car (entsel "\nSelect Block Entity: ")))
  26.    (if (eq (cdr (assoc 0 (entget ent))) "INSERT")
  27.      (progn
  28.        (setq b_obj (vlax-ename->vla-object ent)
  29.              b_name (if (vlax-property-available-p b_obj 'effectivename) (vla-get-effectivename b_obj) (vla-get-name b_obj))
  30.        );end_setq
  31.        (princ (strcat "\nBlock Name : " b_name))
  32.     );end_progn
  33.    );end_if
  34.  );end_while
  35.  
  36.  (setq b_dist (getdist "\nEnter Distance between Blocks :")
  37.        b_size (getreal "\nEnter Scale for Blocks : ")
  38.        t_dist b_dist
  39.  );end_setq
  40.  
  41.  
  42.  (while (setq ent (car (entsel "\nSelect Polyline/Spline Entity : ")))
  43.    (if (member (cdr (assoc 0 (entget ent))) '("SPLINE" "POLYLINE" "LWPOLYLINE" "LINE"))
  44.      (setq l_obj (vlax-ename->vla-object ent))
  45.    );end_if
  46.  
  47.    (cond (l_obj
  48.                (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
  49.                (vla-startundomark c_doc)
  50.  
  51.                (setq l_len (vlax-curve-getdistatpoint l_obj (vlax-curve-getendpoint l_obj)))
  52.  
  53.                (while (< t_dist l_len)
  54.                  (setq i_pt (vlax-curve-getpointatdist l_obj t_dist)
  55.                        r_ang (angle '(0 0 0) (vlax-curve-getfirstderiv l_obj (vlax-curve-getparamatpoint l_obj i_pt)))
  56.                        n_obj (vla-insertblock ms (vlax-3d-point i_pt) b_name b_size b_size b_size r_ang)
  57.                        b_lst (cons n_obj b_lst)
  58.                        t_dist (+ t_dist b_dist)
  59.                  );end_setq
  60.                );end_while
  61.  
  62.                (setq ans "No")
  63.                (initget "Yes No")
  64.                (setq ans (getkword (strcat "\nRotate Blocks 180? [Yes / No] < " ans " > : ")))
  65.                (if (= ans "Yes")
  66.                  (foreach blk b_lst
  67.                    (vla-put-rotation blk (+ pi (vla-get-rotation blk)))
  68.                  );end_foreach
  69.                );end_if
  70.                (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
  71.             )
  72.    );end_cond
  73.    (setq b_lst nil
  74.          t_dist b_dist
  75.    );end_setq
  76.  );end_while
  77.  (setvar 'dynprompt dynp)
  78.  (setvar 'dynmode dynm)
  79.  (princ)
  80. );end_defun
  81.  

milanp

  • Mosquito
  • Posts: 9
Re: measure command
« Reply #4 on: November 09, 2018, 11:55:25 AM »
It works all great!



Hvala Marko na odgovoru.
Pocetnik sam u lisp programiranju i svakako ce mi u buducnosti znaciti sugestije koje si napisao. Nadam se u skorije vreme.  :-)
« Last Edit: November 09, 2018, 12:04:40 PM by milanp »