Visual LISP, AutoLISP and General Customization

Visual LISP, AutoLISP and General Customization

Reply
New Member
Sportster
Posts: 2
Registered: ‎04-17-2009
Message 1 of 7 (320 Views)

Block recognition / automatically convert recognised linework to block

320 Views, 6 Replies
04-17-2009 02:47 PM
Some raster to vector conversion software have a symbol recognition function.

Is it possible to automatically convert all linework that resembles a known block to the proper block in AutoCAD using lisp?
The linework in the AutoCAD drawing has been created using WMFIN (previously from a complex linetype).

Thanks in advance
*Martti Halminen
Message 2 of 7 (320 Views)

Re: Block recognition / automatically convert recognised linework to block

04-20-2009 02:07 AM in reply to: Sportster
Sportster wrote:
> Some raster to vector conversion software have a symbol recognition
> function. Is it possible to automatically convert all linework that
> resembles a known block to the proper block in AutoCAD using lisp? The
> linework in the AutoCAD drawing has been created using WMFIN (previously
> from a complex linetype). Thanks in advance

If by automatically you mean using some already existing functionality,
there is nothing like that built-in.

AutoLISP is a Turing-complete programming language, so, theoretically,
anything you can program a computer to do can also be programmed in
AutoLISP, just like in any other language, though some things may be far
easier in some system already having the necessary tools.

A general-purpose block recognition program would be extremely painful
to write, a human being is far better at this task than a computer.
Essentially, you would need to compare every component in the drawing to
every component in each block definition, going through the whole
drawing again and again to find any possible other parts of the block.
And what about rotation? And how close resemblance is needed?
Probably the easiest way to do this would be to convert the drawing to
raster (thereby bypassing all drawing order and drawing direction
dependencies), find the block candidates in that form, and then try to
find the corresponding vector components.

Writing a program to find probable instances of one block with some
special form (for example two concentric circles and a dotted-line cross
through the center) would be far simpler.

--
*Tony Tanzillo
Message 3 of 7 (320 Views)

Re: Block recognition / automatically convert recognised linework to block

04-20-2009 05:24 AM in reply to: Sportster
Yes that's possible, but not easy. It ultimately depends on how
many blocks you are trying to recognize, and their complexity.

I did it as part of an "implode" application that was supposed to
recognize the geometry produced by exploding block insertions,
and replace that with the original block insertion. That entailed
not only symbol recognition, but also recognizing symbols whose
geometry was subsequently edited after having been exploded.
I can only claim partial success, and I was able to take advantage
of the fact that certain objects from the exploded insertion were
on dedicated layers.

The problem in its most generic form is definitely non-trivial, and
requires fairly complicated pattern matching that can also deduce
or infer varying transformations of each insertion (e.g., position,
rotation, scale, and mirroring).

If you have raster-to-vector conversion software that can do it,
I would definitely consider plotting to a raster file, and letting the
conversion software have a go at it.


--
http://www.caddzone.com

AcadXTabs: MDI Document Tabs for AutoCAD 2009
Supporting AutoCAD 2000 through 2009

http://www.acadxtabs.com

Introducing AcadXTabs 2010:
http://www.caddzone.com/acadxtabs/AcadXTabs2010.htm


wrote in message news:6165178@discussion.autodesk.com...
Some raster to vector conversion software have a symbol recognition
function. Is it possible to automatically convert all linework that
resembles a known block to the proper block in AutoCAD using lisp? The
linework in the AutoCAD drawing has been created using WMFIN (previously
from a complex linetype). Thanks in advance
Valued Mentor
stevor
Posts: 881
Registered: ‎12-26-2005
Message 4 of 7 (320 Views)

Re: Block recognition / automatically convert recognised linework to block

04-20-2009 10:03 AM in reply to: Sportster
Yep.

We did it first for Intergraph generated arrowheads: a gross of little hatch like lines that looked like an arrowhead.

Later for more generalized furniture and interior construction shapes, albiet with much more code.

For your 'linework,' if actually LINEs, you would:

1.get the size of the dominant LINE, and then make a member-list that relates the other line entities to it.

2. search for other instances of this set by ssget "c", or "w" or "cp" for boundary that would get all of the probable members; and remember that some zooms may be required.

3. test each ss collection by the 'member-list

4. insert a block for suitable matches, orient if required.
S
New Member
Sportster
Posts: 2
Registered: ‎04-17-2009
Message 5 of 7 (320 Views)

Re: Block recognition / automatically convert recognised linework to block

04-25-2009 02:37 PM in reply to: Sportster
Thanks to all that replied.
Your suggestions have been very useful.

S
Active Contributor
ACT-Standards
Posts: 39
Registered: ‎05-19-2008
Message 6 of 7 (217 Views)

Re: Block recognition / automatically convert recognised linework to block

08-25-2011 12:09 AM in reply to: *Tony Tanzillo

Tony,

   Any chance you would post the code for your implode routine?

Cheers

 

Paul

Active Contributor
ACT-Standards
Posts: 39
Registered: ‎05-19-2008
Message 7 of 7 (193 Views)

Re: Block recognition / automatically convert recognised linework to block

09-23-2011 04:23 PM in reply to: ACT-Standards

I have written a program to convert all matching trees drawn as individual circles or polylines to blocks.

It would be easy to get it to work with other entities. It does have limitations and needs a bit of tidying up.

When I get time I would like it to improve it to match different scales in one go. When selecting a tree canopy it cannot be partially off the screen.

 

Here is the code and a test drawing.

 

 

         ;;                       --=={  treeHUGGER.LSP  }==--                       ;;
         ;;                                                                          ;;

 

(defun C:TH ()
       (c:treeHUGGER)
)

                              ;;  --=={ Main Program }==-- ;;
      

 
(defun C:treeHUGGER (/ canopyENTNAME GetSSofmatchingCanopy matchingITEMS ReferenceDATA SourceEntityLIST bufferSELECTIONSET adoc acsp FLTR) 
       (vl-load-com)
       (setvar "cmdecho" 0)
       (setvar "osmode" 0)
       (setvar "ucsicon" 0)
       (setvar "lunits" 2)
       (setvar "insunits" 0)
       (setq newBLOCKlayer (getvar "clayer"))
       (setq matchingITEMS 0)
       (setq ReferenceDATA nil)
       (or adoc (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
       (or acsp (setq acsp (vla-get-block (vla-get-activelayout adoc))))
       (command "ucs" "world")
       (Setq FLTR    '((0 . "CIRCLE")))
       (PRINC "\nPlease select circle representing canopy of tree to convert\n")
       (setq canopyENTNAME (acet-ui-single-select FLTR T))
       (if (not (wcmatch (vla-get-objectname (setq canopyOBJ (vlax-ename->vla-object canopyENTNAME))) "AcDbCircle"))
                 (princ "\nInvald selection\n")
                 (progn
                      (setq LOOP T)
                      (while LOOP
                             (setq BLK (getstring t (strcat "\nEnter the name of the block to create: ")))
                             (setq BLK (xstrcase BLK))
                             (cond
                               ((not (snvalid BLK))
                                 (princ "\nInvalid block name.")
                               )
                               ((tblobjname "BLOCK" BLK)
                                 (princ (strcat "\nBlock " BLK " already exists."))
                                 (initget "Yes" 128)
                                 (if (= (getkword "\nRedefine it? <N>") "Yes")
                                   (setq LOOP nil)
                                 )
                               )
                               (T
                                 (setq LOOP nil)
                               )
                             )
                      )
                    (princ "\nAnalysing tree geometry")
                    (getGEOMETRY_function)
                    (command "-layer" "set" "0" "")
                    (command "chprop" bufferSELECTIONSET "" "LAYER" "0" "")
                    (command "chprop" canopyENTNAME "" "LAYER" "0" "")
                    (command "-block" BLK canopyCENTRE canopyENTNAME bufferSELECTIONSET "")
                    (command "-layer" "set" newBLOCKlayer "")
                    (command "-insert" blk canopyCENTRE "" "" "")
                 )
              )
       (setq ReferenceDATA SourceEntityLIST
             SourceEntityLIST nil
       )
       (command "ucs" "world")
       (setq GetSSofmatchingCanopy (ssget "X" canopyINFO))
       (command "zoom" "extents");ESSENTIAL
       (princ "\nLocating similar tree geometry")
       (setq cntr 0)
       (while (< cntr (sslength GetSSofmatchingCanopy))  
              (setq canopyENTNAME (ssname GetSSofmatchingCanopy cntr))
              (if (not (wcmatch (vla-get-objectname (setq canopyOBJ (vlax-ename->vla-object canopyENTNAME))) "AcDbCircle"))
                 (princ "")
                    (progn
                       (getGEOMETRY_function)
                       (if (equal ReferenceDATA SourceEntityLIST 0.01)
                           (progn
                             (mapcar '(lambda (ent) (vla-Delete (vlax-ename->vla-object Ent)))
                             (vl-remove-if-not '(lambda (x) (= (type x) 'ename)) (mapcar 'cadr (ssnamex bufferSELECTIONSET))))
                             (entdel canopyENTNAME)
                             (command "-insert" blk canopyCENTRE "" "" "")
                             (setq matchingITEMS (+ 1 matchingITEMS))
                           )
                       )
                    )
              )
              (setq cntr (1+ cntr))
       )
       (setvar "ucsicon" 3)
       (PRINC (STRCAT "\nThe selected tree and " (itoa matchingITEMS) " matching tree symbols"))
       (PRINC (STRCAT "\nhave been replaced with block " BLK " on the current layer\n"))
       (princ)
)

 

 

                              ;;  --=={ Sub-Functions }==-- ;;

(defun bufferPOINTS_function (obj num / div bufferPOINTS)
      (setq div (/ (vlax-curve-getendparam obj) num)
            bufferPOINTS (cons (vlax-curve-getpointatparam obj (vlax-curve-getstartparam obj)) bufferPOINTS)
      )
      (while  (> num 1)
          (setq bufferPOINTS (cons (vlax-curve-getpointatparam obj (* (1- num) div)) bufferPOINTS)
                num (1- num)
          )
      )
      bufferPOINTS
)

(defun getGEOMETRY_function (/ ssSourcetree)
    (command "ucs" "w")
    (setq canopyCENTRE (vlax-get canopyOBJ 'center)
          CanopyRADIUS (vlax-get canopyOBJ 'radius)
          CanopyLAYER (vlax-get canopyOBJ 'layer)
          CanopyINFO (list (cons 0 "CIRCLE") (cons 8 CanopyLAYER) (cons 40 CanopyRADIUS))
          circleBUFFER (vla-addcircle acsp (vlax-3d-point canopyCENTRE) (* 1.01 CanopyRADIUS))
          bufferPOINTS (bufferPOINTS_function circleBUFFER 32)
          bufferSELECTIONSET (ssget "_WP" bufferPOINTS (list (cons 8 CanopyLAYER )))
          SourceCanopyLIST (list "CANOPY" " | Canopy Layer: " CanopyLAYER " | Canopy Radius: " CanopyRADIUS )
          SourceEntityLIST (list SourceCanopyLIST)
    )
    (if (ssmemb canopyENTNAME bufferSELECTIONSET)
        (ssdel canopyENTNAME bufferSELECTIONSET)
    );remove canopy from bufferSELECTIONSE
    (ProcessENTITIES_function)
    (vla-delete circleBUFFER)
    (princ)
)

(Defun ProcessENTITIES_function ()
    (setq PEcntr 0)
    (while (< PEcntr (sslength bufferSELECTIONSET))  
           (setq sel_ent (ssname bufferSELECTIONSET PEcntr)
                 sel_objtype (vla-get-objectname (setq sel_obj (vlax-ename->vla-object sel_ent)))
           )
           (cond
              ((= sel_objtype "AcDbCircle")(ProcessCIRCLE_function))
              ((= sel_objtype "AcDbPolyline")(ProcessPLINE_function))
              ((= sel_objtype "AcDbLine")(princ "\nLine selected"))
              ((= sel_objtype "AcDbPoint")(princ "\nPoint selected"))
              ((= sel_objtype "AcDbHatch")(princ "\nHatch selected"))
              ((= sel_objtype "AcDbArc")(princ "\nArc selected"))
              ((= sel_objtype "AcDbInsert")(princ "\nBlock selected"))
              (princ (strcat "\n" sel_obj " selected"))
              (princ "")
          )
          (setq PEcntr (1+ PEcntr))
   )
)

(defun ProcessPLINE_function ()
         (setq EntityLAYER (vlax-get-property sel_obj 'Layer)
               EntityCLOSED? (vlax-get-property sel_obj 'closed)
         )
         (if (= EntityCLOSED? :vlax-false)
              (setq EntityCLOSED? "No");open
              (setq EntityCLOSED? "Yes");closed
         )
         (setq EntityCOORDS (getlwpolyDATA_function sel_obj))
         (command "ucs" "or" canopyCENTRE);set UCS to centre of canopy
         (setq UCSentitycoords (WCS2UCS_function entitycoords); convert coordinates of polyline from World to current UCS
               EntityINFO  (List sel_objtype " | Layer = " EntityLayer " | Coordinates relative to canopy centre = " UCSentitycoords " | Closed polyline? = " Entityclosed?)
         )
         (command "ucs" "world")
         (setq SourceEntityLIST (append SourceEntityLIST (list EntityInfo)))
)

(defun ProcessCIRCLE_function ()
         (setq EntityLAYER (vlax-get-property sel_obj 'Layer)
               EntityCENTER (vlax-get-property sel_obj 'Center)
               EntityRADIUS (vlax-get sel_obj 'radius)
               EntityCOORDS (vlax-safearray->list  (variant-value EntityCENTER))
         )
         (command "ucs" "or" canopyCENTRE)
         (setq EntityCOORDS (list EntityCOORDS)
               UCSentityCOORDS (WCS2UCS_function entityCOORDS)
               EntityINFO  (List sel_objtype " | Layer = " EntityLAYER " | Coordinates relative to canopy centre = " UCSentityCOORDS " | Radius = " EntityRADIUS )
         )
         (command "ucs" "world")
         (setq SourceEntityLIST (append SourceEntityLIST (list EntityInfo)))
)

(defun WCS2UCS_function (EntityCOORDS / res)
        (setq res (mapcar '(lambda (x) (trans x 0 1)) EntityCOORDS))
        (if (= 1 (length res))
                 (car res)
                 res
        )
)

(defun getlwpolyDATA_function (lwpolyOBJ / i)
       (setq i -1)
       (mapcar '(lambda (coord) (append coord (list (vla-getbulge lwpolyOBJ (setq i (1+ i))))))
       (Coordinates->List_function (vla-get-coordinates lwPolyOBJ) 2 ))
)

(defun Coordinates->List_function (array dims / vlist rslt)
       (if (eq (type array) 'variant)
               (setq array (vlax-variant-value array))
       )
       (setq vlist (vlax-safearray->list array))
       (if (eq dims 2)
           (while vlist
             (setq rslt (cons (list (car vlist) (cadr vlist)) rslt) vlist (cddr vlist)
           )
       )
       (while vlist
             (setq rslt (cons (list (car vlist) (cadr vlist) (caddr vlist)) rslt) vlist (cdddr vlist))))
       (reverse rslt)
)

(princ "\nType treeHUGGER or TH to run...")
(princ)

Post to the Community

Have questions about Autodesk products? Ask the community.

New Post
Announcements
Are You Going To Be @ AU 2014? Feel free to drop by our AU topic post and share your plans, plug a class that you're teaching, or simply check out who else from the community might be in attendance. Ohh and don't forgot to stop by the Autodesk Help | Learn | Collaborate booths in the Exhibit Hall and meet our community team if you get a chance!