« previous next »
Pages: [1] |   Go Down

Author Topic: measure command  (Read 1785 times)

0 Members and 1 Guest are viewing this topic.

milanp

  • Newt
  • Posts: 35
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)
) 
Logged

Dlanor

  • Bull Frog
  • Posts: 263
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.
Logged

ribarm

  • Gator
  • Posts: 3249
  • 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))
Logged
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

Dlanor

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

milanp

  • Newt
  • Posts: 35
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 »
Logged
Pages: [1] |   Go Up
« previous next »