Author Topic: Need a gide to Draw a PLine  (Read 2926 times)

0 Members and 1 Guest are viewing this topic.

HasanCAD

  • Swamp Rat
  • Posts: 1420
Need a gide to Draw a PLine
« on: October 08, 2017, 06:49:32 AM »
Hi all
Could some one gide me how to code a lisp to draw a Pline in insertion point of a block related to an attribute value in sequence
and if duplicate draw any symbol.
Attached a sample
Thanks

Lee Mac

  • Seagull
  • Posts: 12905
  • London, England
Re: Need a gide to Draw a PLine
« Reply #1 on: October 08, 2017, 07:06:15 AM »
  • Obtain a selection set of the target attributed blocks
  • Iterate over the selection:
    • Retrieve the block insertion point
    • Retrieve the appropriate attribute values
    • Construct an association list containing the attribute values paired with the insertion point
  • Sort the association list by the attribute values
  • Construct a polyline with vertices located at the points in the sorted list

HasanCAD

  • Swamp Rat
  • Posts: 1420
Re: Need a gide to Draw a PLine
« Reply #2 on: October 09, 2017, 09:53:56 AM »
Thanks LEE

Needed sorting in sequence

this part not working well this is for check if duplicate 
Code - Auto/Visual Lisp: [Select]
  1.           (setq blkpnt1 (nth 0 (nth sr lsts )))
  2.           (setq blkatt1 (nth 1 (nth sr lsts )))
  3.           (if (setq srr (1+ sr))
  4.             (progn
  5.               (setq blkpnt2 (nth 0 (nth (1+ sr) lsts )))
  6.               (setq blkatt2 (nth 1 (nth (1+ sr) lsts )))
  7.               ))
  8.           (if (eq blkatt1 blkatt2)
  9.             (progn
  10.               (setq crc (vla-AddCircle spc (vlax-3d-point (trans blkpnt2 1 0)) 1000))
  11.               (vla-put-layer crc "Defpoints")
  12.               (vla-put-color crc 256)
  13.               (setq sr (+ 2 sr))
  14.               )
  15.             (progn
  16.               (setq pnts (cons blkpnt1 pnts))
  17.               (setq sr (1+ sr))
  18.               ))

full code
Code - Auto/Visual Lisp: [Select]
  1. (defun c:RmN ( / ATT BLKATT1 BLKATT2 BLKNM BLKPNT1 BLKPNT2 CRC DOC ENT I IP LSTS NM OBJ OBJDATA OBJVL P1 P2 PNT PNTS S SPC SR SRR SS TG  )
  2.  
  3.   (setq blknm "CAP-RMN-ALL")
  4.   (setq tg "RN")
  5.   (setq lsts nil)
  6.   (setq pnts nil)
  7.   (if (and
  8.         (setq p1 (getpoint "\nSelect blocks: "))
  9.         (setq p2 (getcorner p1 "\nSelect blocks: "))   
  10.         (setq ss (ssget "_C" p1 p2 '((0 . "INSERT" ) (66 . 1))))
  11.         )
  12.     (progn
  13.       (setq pnts (list p2))
  14.     (repeat (setq i (sslength ss))
  15.       (setq ent (entget (setq obj (ssname ss (setq i (1- i))))))
  16.       (if (eq blknm (setq nm (LM:name->effectivename (cdr (assoc 2 ent)))))
  17.         (progn
  18.           (setq objVL (vlax-ename->vla-object obj))
  19.           (setq ip (vla-get-insertionpoint objVL))
  20.           (setq ip (vlax-SafeArray->List (vlax-Variant-Value ip)))
  21.           (setq att (LM:vl-getattributevalue objVL tg))
  22.           (setq objdata (list ip att))
  23.           (setq lsts (cons objdata lsts))
  24.           ))
  25.       )))
  26.  
  27.   ; lsts in sequence
  28.  
  29.   (if (and
  30.         (< 0 (setq s (length lsts)))
  31.         (setq sr 0)
  32.         )
  33.         (repeat s
  34.           (setq blkpnt1 (nth 0 (nth sr lsts )))
  35.           (setq blkatt1 (nth 1 (nth sr lsts )))
  36.           (if (setq srr (1+ sr))
  37.             (progn
  38.               (setq blkpnt2 (nth 0 (nth (1+ sr) lsts )))
  39.               (setq blkatt2 (nth 1 (nth (1+ sr) lsts )))
  40.               ))
  41.           (if (eq blkatt1 blkatt2)
  42.             (progn
  43.               (setq crc (vla-AddCircle spc (vlax-3d-point (trans blkpnt2 1 0)) 1000))
  44.               (vla-put-layer crc "Defpoints")
  45.               (vla-put-color crc 256)
  46.               (setq sr (+ 2 sr))
  47.               )
  48.             (progn
  49.               (setq pnts (cons blkpnt1 pnts))
  50.               (setq sr (1+ sr))
  51.               ))
  52.           (setq pnts (apply 'append pnts))
  53.           (setq pnt (vlax-make-safearray vlax-vbDouble (cons 0 (- (length pnts) 1))))
  54.           (vlax-safearray-fill pnt pnts)
  55.           (setq obj (vla-addPolyline spc pnt))
  56.           (vla-put-layer obj "Defpoints")
  57.           (vla-put-color OBJ 256)
  58.           )))
  59.  
  60. ;; Block Name -> Effective Block Name  -  Lee Mac
  61. ;; blk - [str] Block name
  62. (defun LM:name->effectivename (blk / rep)
  63.   (if (and (wcmatch blk "`**")
  64.            (setq
  65.              rep (cdadr
  66.                    (assoc
  67.                      -3
  68.                      (entget
  69.                        (cdr (assoc 330 (entget (tblobjname "block" blk))))
  70.                        '("AcDbBlockRepBTag")
  71.                      )
  72.                    )
  73.                  )
  74.            )
  75.            (setq rep (handent (cdr (assoc 1005 rep))))
  76.       )
  77.     (cdr (assoc 2 (entget rep)))
  78.     blk
  79.   )
  80. ) (princ)
  81.  
  82. ;; Get Attribute Value  -  Lee Mac
  83. ;; Returns the value held by the specified tag within the supplied block, if present.
  84. ;; blk - [vla] VLA Block Reference Object
  85. ;; tag - [str] Attribute TagString
  86. ;; Returns: [str] Attribute value, else nil if tag is not found.
  87. (defun LM:vl-getattributevalue (blk tag)
  88.   (setq tag (strcase tag))
  89.   (vl-some '(lambda (att)
  90.               (if (= tag (strcase (vla-get-tagstring att)))
  91.                 (vla-get-textstring att)
  92.               )
  93.             )
  94.            (vlax-invoke blk 'getattributes)
  95.   )
  96. )

Lee Mac

  • Seagull
  • Posts: 12905
  • London, England
Re: Need a gide to Draw a PLine
« Reply #3 on: October 09, 2017, 01:36:04 PM »
Great start Hasan, well done!

Here's a nudge in the right direction - I would suggest testing for duplicates whilst acquiring the initial dataset, this saves an iteration of the dataset and avoids problems when sorting:
Code - Auto/Visual Lisp: [Select]
  1. (defun c:rmn ( / blk ent enx idx lst sel tag val )
  2.     (setq blk "CAP-RMN-ALL"
  3.           tag "RN"
  4.     )
  5.     (if (setq sel (ssget (list '(0 . "INSERT") '(66 . 1) (cons 2 (strcat "`*U*," blk)))))
  6.         (progn
  7.             (repeat (setq idx (sslength sel))
  8.                 (setq idx (1- idx)
  9.                       ent (ssname sel idx)
  10.                       enx (entget ent)
  11.                 )
  12.                 (if (and (= (strcase blk) (strcase (LM:name->effectivename (cdr (assoc 2 enx)))))
  13.                          (setq val (LM:getattributevalue ent tag))
  14.                          (setq val (atoi val))
  15.                     )
  16.                     (if (assoc val lst)
  17.                         (entmake (list '(0 . "CIRCLE") (assoc 10 enx) '(40 . 1000.0) '(8 . "Defpoints") '(62 . 256)))
  18.                         (setq lst (cons (cons val (assoc 10 enx)) lst))
  19.                     )
  20.                 )
  21.             )
  22.             (entmake
  23.                 (append
  24.                     (list
  25.                        '(000 . "LWPOLYLINE")
  26.                        '(100 . "AcDbEntity")
  27.                        '(100 . "AcDbPolyline")
  28.                        '(008 . "Defpoints")
  29.                        '(062 . 256)
  30.                         (cons 90 (length lst))
  31.                        '(070 . 0)
  32.                     )
  33.                     (mapcar 'cdr (vl-sort lst '(lambda ( a b ) (< (car a) (car b)))))
  34.                 )
  35.             )
  36.         )
  37.     )
  38.     (princ)
  39. )
  40.                          
  41. ;; Get Attribute Value  -  Lee Mac
  42. ;; Returns the value held by the specified tag within the supplied block, if present.
  43. ;; blk - [ent] Block (Insert) Entity Name
  44. ;; tag - [str] Attribute TagString
  45. ;; Returns: [str] Attribute value, else nil if tag is not found.
  46.  
  47. (defun LM:getattributevalue ( blk tag / enx )
  48.     (if (and (setq blk (entnext blk)) (= "ATTRIB" (cdr (assoc 0 (setq enx (entget blk))))))
  49.         (if (= (strcase tag) (strcase (cdr (assoc 2 enx))))
  50.             (cdr (assoc 1 (reverse enx)))
  51.             (LM:getattributevalue blk tag)
  52.         )
  53.     )
  54. )
  55.  
  56. ;; Block Name -> Effective Block Name  -  Lee Mac
  57. ;; blk - [str] Block name
  58.  
  59. (defun LM:name->effectivename ( blk / rep )
  60.     (if
  61.         (and (wcmatch blk "`**")
  62.             (setq rep
  63.                 (cdadr
  64.                     (assoc -3
  65.                         (entget
  66.                             (cdr (assoc 330 (entget (tblobjname "block" blk))))
  67.                            '("AcDbBlockRepBTag")
  68.                         )
  69.                     )
  70.                 )
  71.             )
  72.             (setq rep (handent (cdr (assoc 1005 rep))))
  73.         )
  74.         (cdr (assoc 2 (entget rep)))
  75.         blk
  76.     )
  77. )
  78.  

HasanCAD

  • Swamp Rat
  • Posts: 1420
Re: Need a gide to Draw a PLine
« Reply #4 on: October 09, 2017, 02:10:51 PM »
It is very good idea

Thanks LEE for help

edit:
By the way, I was creating the selection by points because I want to make these 2 points as a start and eand of the pline.
« Last Edit: October 09, 2017, 02:16:15 PM by HasanCAD »

Lee Mac

  • Seagull
  • Posts: 12905
  • London, England
Re: Need a gide to Draw a PLine
« Reply #5 on: October 09, 2017, 02:43:06 PM »
It is very good idea

Thanks LEE for help

edit:
By the way, I was creating the selection by points because I want to make these 2 points as a start and eand of the pline.

You're most welcome Hasan - I have confidence that you can modify the code from here  :-)

Tharwat

  • Swamp Rat
  • Posts: 707
  • Hypersensitive
Re: Need a gide to Draw a PLine
« Reply #6 on: October 09, 2017, 02:54:38 PM »
Hi,
One selection creates one polyine with zero length.  :grinwink:

HasanCAD

  • Swamp Rat
  • Posts: 1420
Re: Need a gide to Draw a PLine
« Reply #7 on: October 11, 2017, 02:29:16 AM »
...
You're most welcome Hasan - I have confidence that you can modify the code from here  :-)
Thanks for the first push, I'll modify to match my needs.
« Last Edit: October 11, 2017, 03:03:30 AM by HasanCAD »

HasanCAD

  • Swamp Rat
  • Posts: 1420
Re: Need a gide to Draw a PLine
« Reply #8 on: October 11, 2017, 02:31:11 AM »
Hi,
One selection creates one polyine with zero length.  :grinwink:
Thanks Tharwat for your comment.

Tharwat

  • Swamp Rat
  • Posts: 707
  • Hypersensitive
Re: Need a gide to Draw a PLine
« Reply #9 on: October 11, 2017, 02:44:39 AM »
Hi,
One selection creates one polyine with zero length.  :grinwink:
Thanks Tharwat for your comment.

No problem,
Just for clarifications. I am not picking up the codes rather than trying to pay attention to one important issue of the posted codes.

HasanCAD

  • Swamp Rat
  • Posts: 1420
Re: Need a gide to Draw a PLine
« Reply #10 on: October 11, 2017, 07:20:26 AM »
Hi,
One selection creates one polyine with zero length.  :grinwink:
Thanks Tharwat for your comment.

No problem,
Just for clarifications. I am not picking up the codes rather than trying to pay attention to one important issue of the posted codes.

Ofcource
and your value comments are appreciated.

Thanks Thaewat

HasanCAD

  • Swamp Rat
  • Posts: 1420
Re: Need a gide to Draw a PLine
« Reply #11 on: October 12, 2017, 05:57:20 AM »
This is what I ended up to
but this line gives nil
Code - Auto/Visual Lisp: [Select]
  1. (= (strcase blk) (strcase (LM:name->effectivename (cdr (assoc 2 enx)))))
Code
Code - Auto/Visual Lisp: [Select]
  1. (defun c:RoomNameLink ( / blk ent enx idx lst lst2 sel tag val p1 p2 strt lstl)
  2.  
  3.     (if (and
  4.           (setq att (car (nentsel "\nSelect attribute: ")))
  5.           (= "ATTRIB" (cdr (assoc 0 (entget att))))
  6.           (setq tag (cdr (assoc 2 (entget att))))
  7.           (setq attobj (vlax-ename->vla-object att))
  8.           (setq blkobj (cdr (assoc 330 (entget att))))
  9.           (setq blk (cdr (assoc 8 (entget blkobj))))
  10.           (setq p1 (getpoint "\nSelect blocks: "))
  11.           (setq p2 (getcorner p1 "\nSelect blocks: "))
  12.           (setq sel (ssget "_C" p1 p2 (list '(0 . "INSERT") '(66 . 1) (cons 2 (strcat "`*U*," blk)))))
  13.           )
  14.         (progn
  15.             (repeat (setq idx (sslength sel))
  16.                 (setq idx (1- idx)
  17.                       ent (ssname sel idx)
  18.                       enx (entget ent))
  19.                 (if (and ;(= (strcase blk) (strcase (LM:name->effectivename (cdr (assoc 2 enx)))))
  20.                          (setq val (LM:getattributevalue ent tag))
  21.                          (setq val (atoi val)))
  22.                     (if (assoc val lst)
  23.                         (entmake (list '(0 . "CIRCLE") (assoc 10 enx) '(40 . 1000.0) '(8 . "Defpoints") '(62 . 256)))
  24.                         (setq lst (cons (cons val (assoc 10 enx)) lst))
  25.                     )))
  26.           (if (< 1 (setq lstl (length lst)))
  27.             (progn
  28.             (setq lst (vl-sort lst '(lambda ( a b ) (< (car a) (car b)))))
  29.             (setq p2 (cons (1- (nth 0 (nth 0 lst))) (cons 10 p2)))
  30.             (entmake
  31.                 (append
  32.                     (list '(000 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(008 . "Defpoints") '(062 . 256)
  33.                           (cons 90 (1+ lstl)) '(070 . 0))
  34.                     (mapcar 'cdr (cons p2 lst))
  35.                 )))))) (princ))
  36.  
  37. ;; Get Attribute Value  -  Lee Mac
  38. ;; Returns the value held by the specified tag within the supplied block, if present.
  39. ;; blk - [ent] Block (Insert) Entity Name
  40. ;; tag - [str] Attribute TagString
  41. ;; Returns: [str] Attribute value, else nil if tag is not found.
  42. (defun LM:getattributevalue ( blk tag / enx ) (if (and (setq blk (entnext blk)) (= "ATTRIB" (cdr (assoc 0 (setq enx (entget blk)))))) (if (= (strcase tag) (strcase (cdr (assoc 2 enx)))) (cdr (assoc 1 (reverse enx))) (LM:getattributevalue blk tag))))
  43.  
  44. ;; Block Name -> Effective Block Name  -  Lee Mac
  45. ;; blk - [str] Block name
  46. (defun LM:name->effectivename ( blk / rep ) (if (and (wcmatch blk "`**") (setq rep (cdadr (assoc -3 (entget (cdr (assoc 330 (entget (tblobjname "block" blk)))) '("AcDbBlockRepBTag"))))) (setq rep (handent (cdr (assoc 1005 rep))))) (cdr (assoc 2 (entget rep))) blk)) (princ)
« Last Edit: October 12, 2017, 08:38:30 AM by HasanCAD »

Lee Mac

  • Seagull
  • Posts: 12905
  • London, England
Re: Need a gide to Draw a PLine
« Reply #12 on: October 12, 2017, 12:42:14 PM »
Code: [Select]
(setq blk (cdr (assoc 8 (entget blkobj))))
Your 'blk' variable is currently storing the layer name of the block, not the block name.

HasanCAD

  • Swamp Rat
  • Posts: 1420
Re: Need a gide to Draw a PLine
« Reply #13 on: October 15, 2017, 04:51:20 AM »
Code: [Select]
(setq blk (cdr (assoc 8 (entget blkobj))))
Your 'blk' variable is currently storing the layer name of the block, not the block name.


 :oops: :oops: :oops: